Cleanup and reorganise

src/Dodge/Base/Window.hs

@@ -1,5 +1,13 @@
 {- | Getting the window size geometry. -}
 module Dodge.Base.Window
+    ( halfWidth
+    , halfHeight
+    , screenPolygon
+    , screenPolygonBord
+    , getWindowX
+    , getWindowY
+    , screenBox
+    )
     where
 import Dodge.Data
 import Dodge.Config.Data
@@ -7,16 +15,17 @@ import Geometry
 
 -- | A box covering the screen in world coordinates
 screenPolygon :: World -> [Point2]
-screenPolygon w = [tr,tl,bl,br]
+screenPolygon w = map (scTran . scRot . scZoom) $ screenBox w
+--    [tr,tl,bl,br]
   where 
     scRot  = rotateV (_cameraRot w)
     scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p
              | otherwise = p
     scTran p = p +.+ _cameraCenter w
-    tr = scTran $ scRot $ scZoom (V2 ( halfWidth w) ( halfHeight w)) 
+--    tr = scTran $ scRot $ scZoom (V2 ( halfWidth w) ( halfHeight w)) 
-    tl = scTran $ scRot $ scZoom (V2 (-halfWidth w) ( halfHeight w)) 
+--    tl = scTran $ scRot $ scZoom (V2 (-halfWidth w) ( halfHeight w)) 
-    br = scTran $ scRot $ scZoom (V2 ( halfWidth w) (-halfHeight w))
+--    br = scTran $ scRot $ scZoom (V2 ( halfWidth w) (-halfHeight w))
-    bl = scTran $ scRot $ scZoom (V2 (-halfWidth w) (-halfHeight w))
+--    bl = scTran $ scRot $ scZoom (V2 (-halfWidth w) (-halfHeight w))
 
 -- | A box covering the screen in world coordinates, with a x and y border
 screenPolygonBord 
@@ -44,9 +53,7 @@ getWindowX = _windowX . _config
 getWindowY = _windowY . _config
 
 -- | A box of the size of the screen in screen centered coordinates
-screenBox 
+screenBox :: World -> [Point2]
-    :: World
-    -> [Point2]
 screenBox w = rectNSEW hh (-hh) hw (-hw)
   where
     hw = halfWidth w

src/Dodge/Config/Load.hs

@@ -1,6 +1,5 @@
 module Dodge.Config.Load
-    (
+    ( loadDodgeConfig
-      loadDodgeConfig
     ) where
 import Dodge.Config.Data
 

src/Dodge/Config/Update.hs

@@ -2,7 +2,10 @@
 IO actions that apply config side effects and save configuration settings to disk.
 -}
 module Dodge.Config.Update
-    where
+    ( saveConfig
+    , setVolThen
+    , applyWorldConfig
+    ) where
 --import Dodge.Data.SoundOrigin
 import Dodge.Config.Data
 import Sound
@@ -19,7 +22,6 @@ saveConfig cfig f x = do
     putStrLn "Saving config to data/dodge.config.json"
     encodeFile "data/dodge.config.json" cfig
     f x
-
 {- |
 Apply the volume settings from the world configuration to the running game.
  -}
@@ -28,12 +30,10 @@ setVol cfig = do
     setSoundVolume ( _volume_master cfig * _volume_sound cfig)
     setMusicVolume ( _volume_master cfig * _volume_music cfig)
 
-setVol' :: Configuration -> (a -> IO a) -> a -> IO a
+setVolThen :: Configuration -> (a -> IO a) -> a -> IO a
-setVol' cfig f a = do
+setVolThen cfig f a = do
     setVol cfig 
     f a
-
-
 {- |
 Apply /all/ of the values in the world configuration to the running game.
  -}

src/Dodge/Creature.hs

@@ -13,6 +13,8 @@ module Dodge.Creature
   where
 --import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
+import Dodge.Item.Weapon.Grenade
+import Dodge.Item.Weapon.Booster
 --import Dodge.Creature.ReaderUpdate
 --import Dodge.Creature.AlertLevel
 --import Dodge.Creature.SetTarget
@@ -30,8 +32,10 @@ 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.AutoGun
+import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Weapon.Bezier
 import Dodge.Item.Equipment
 import Dodge.Item.Consumable
@@ -117,7 +121,7 @@ multGunCrit = defaultCreature
                         `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]  ]
               )
             , (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0)
-                [ drawwp `DoActionThen` shootFirstMiss' `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] ]
+                [ drawwp `DoActionThen` shootFirstMiss `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] ]
               ) 
             ]
     , _crActionPlan = ActionPlan

src/Dodge/Creature/AutoCrit.hs

@@ -9,7 +9,7 @@ import Dodge.Creature.SentinelAI
 import Dodge.Creature.Impulse
 import Dodge.Creature.State
 --import Dodge.Creature.State.Data
-import Dodge.Item.Weapon.AutoGun
+import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Consumable
 --import Geometry
 import Picture

src/Dodge/Creature/Inanimate.hs

@@ -3,8 +3,14 @@
 Inanimate objects such as lamps, barrels, etc
 -}
 module Dodge.Creature.Inanimate
-  where
+    ( lamp
+    , colorLamp
+    , barrel
+    , explosiveBarrel
+    ) where
 import Dodge.Data
+import Dodge.Data.DamageType
+import Dodge.WorldEvent.Explosion
 import Dodge.Creature.Picture
 --import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
@@ -22,10 +28,14 @@ import Geometry
 import Geometry.Vector3D
 import Polyhedra
 import Shape
+import Dodge.WorldEvent
+import Dodge.SoundLogic
+import Dodge.Data.SoundOrigin
+import Dodge.SoundLogic.LoadSound
 
+import System.Random
+import Data.List
 import Control.Lens
-import qualified Control.Foldl as L
---import qualified Data.Vector.Fusion.Stream.Monadic as VS
 import Data.Monoid
 
 defaultInanimate :: Creature
@@ -60,18 +70,18 @@ lampCrPic h = pictures
   where
     f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] 0 polyNum
 
-lTriFold :: a -> a -> L.Fold a [a]
+--lTriFold :: a -> a -> L.Fold a [a]
-lTriFold s x = L.Fold (f s) (x,[]) snd
+--lTriFold s x = L.Fold (f s) (x,[]) snd
-  where
+--  where
-    f s' (x1,l) x2 = (x2,s':x1:x2:l)
+--    f s' (x1,l) x2 = (x2,s':x1:x2:l)
-
+--
-preTriFold :: (a -> b) -> [a] -> [b]
+--preTriFold :: (a -> b) -> [a] -> [b]
-preTriFold f (s:x:xs) = L.fold (L.premap f $ lTriFold (f s) (f x)) xs
+--preTriFold f (s:x:xs) = L.fold (L.premap f $ lTriFold (f s) (f x)) xs
-preTriFold _ _ = []
+--preTriFold _ _ = []
-
+--
-polyToTriFold :: [a] -> [a]
+--polyToTriFold :: [a] -> [a]
-polyToTriFold (s:x:xs) = L.fold (lTriFold s x) xs
+--polyToTriFold (s:x:xs) = L.fold (lTriFold s x) xs
-polyToTriFold _ = []
+--polyToTriFold _ = []
 
 initialiseLamp :: Float -> CRUpdate
 initialiseLamp = initialiseColorLamp 0.75
@@ -130,3 +140,59 @@ explosiveBarrel = defaultInanimate
     , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
     ,_crApplyDamage = \_ c -> (id, c)
     }
+updateBarrel 
+    :: Creature 
+    -> World
+    -> (Endo World, Maybe Creature)
+updateBarrel cr _
+    | _crHP cr > 0 = (Endo id, newCr)
+    | otherwise    = (Endo id, Nothing)
+  where 
+    newCr = Just $ doDamage cr
+
+-- should generate the sparks externally using new random generators
+updateExpBarrel 
+    :: Creature 
+    -> World
+    -> (Endo World, Maybe Creature)
+updateExpBarrel cr w 
+    | _crHP cr > 0 = (Endo $ foldr (.) id pierceSparks . hiss, newCr)
+    | otherwise    = (Endo $ makeExplosionAt (_crPos cr) . stopSounds , Nothing)
+  where 
+    g = _randGen w
+    damages = _crDamage $ _crState cr
+    pierceSparks :: [World -> World]
+    pierceSparks 
+      = zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p) (Just $ _crID cr))
+                            poss as times colids
+    as =  randomRs (-0.7,0.7) g
+    colids = randomRs (0,11) g
+    times = randomRs (2,5) g
+    poss = _piercedPoints $ _crSpState $ _crState cr
+    --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages
+    newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr
+    --perforate :: DamageType -> Creature -> Creature
+    --perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints)
+    --                                                  ((:) $ int -.- _crPos cr) cr
+    --perforate _ cr = cr
+    applyFuseDamage cr' = cr' & crHP %~ 
+        subtract (length . _piercedPoints . _crSpState $ _crState cr')
+    hiss | null poss = id
+         | otherwise  = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] (_crPos cr) foamSprayLoopS (Just 1)
+    stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
+
+damToExpBarrel :: [DamageType] -> Creature -> Creature
+damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
+  where 
+    (pierceDam,otherDam) = partition isPierce ds
+    isPierce Piercing{} = True
+    isPierce _             = False
+
+damToExpBarrel' :: DamageType -> Creature -> Creature
+damToExpBarrel' (Piercing amount _ int _) cr 
+    = over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) 
+        $ over crHP (\hp -> hp - div amount 200) cr
+damToExpBarrel' PoisonDam {} cr = cr
+damToExpBarrel' SparkDam {}  cr = cr
+damToExpBarrel' PushDam{_dmPushBack = v} cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v)
+damToExpBarrel' dt             cr = cr Control.Lens.& crHP -~ _dmAmount dt

src/Dodge/Creature/LtAutoCrit.hs

@@ -14,7 +14,7 @@ import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Perception
 import Dodge.Creature.State
 --import Dodge.Creature.State.Data
-import Dodge.Item.Weapon
+import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Consumable
 import Geometry
 import Picture

src/Dodge/Creature/PistolCrit.hs

@@ -14,7 +14,7 @@ import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Perception
 import Dodge.Creature.State
 --import Dodge.Creature.State.Data
-import Dodge.Item.Weapon
+import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Consumable
 import Geometry
 import Picture

src/Dodge/Creature/Property.hs

@@ -1,5 +1,7 @@
 module Dodge.Creature.Property
-    where
+    ( crIsArmouredFrom
+    , crNearSeg
+    ) where
 import Dodge.Data
 import Dodge.Item.Data
 import Geometry
@@ -13,8 +15,8 @@ crIsArmouredFrom p cr
         && angleVV (unitVectorAtAngle $ _crDir cr) (p -.- _crPos cr) < pi/2
 -- even though angleVV can generate NaN, the comparison seems to deal with it
 
-crOnSeg :: Point2 -> Point2 -> Creature -> Bool
+--crOnSeg :: Point2 -> Point2 -> Creature -> Bool
-crOnSeg p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr)
+--crOnSeg p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr)
 
 crNearSeg :: Float -> Point2 -> Point2 -> Creature -> Bool
 crNearSeg d p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr + d)

src/Dodge/Creature/SentinelAI.hs

@@ -1,5 +1,8 @@
 module Dodge.Creature.SentinelAI
-    where
+    ( sentinelAI
+    , sentinelFireType
+    , sentinelExtraWatchUpdate
+    ) where
 import Dodge.Data
 import Dodge.Base.Collide
 import Dodge.Creature.Test
@@ -7,16 +10,10 @@ import Dodge.Creature.Volition
 import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Strategy
 import Dodge.Creature.Action
---import Dodge.Creature.ChooseTarget
 import Dodge.Creature.Perception
---import Dodge.Creature.State
---import Dodge.Creature.State.Data
 import Geometry.Data
---import Picture
---import Dodge.RandomHelp
 
 import Data.Maybe
---import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Control.Monad
 import Control.Monad.Reader
@@ -84,38 +81,38 @@ sentinelExtraWatchUpdate xs = performActionsR
         (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr)
         (pure . (crActionPlan . crStrategy .~ WatchAndWait))
 
-shootAtAdvance :: Int -> [Action]
+--shootAtAdvance :: Int -> [Action]
-shootAtAdvance tcid =
+--shootAtAdvance tcid =
-    [ DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction))
+--    [ DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction))
-      `DoActionThen`
+--      `DoActionThen`
-        lostest `DoActionWhile`
+--        lostest `DoActionWhile`
-        advanceShoot `DoActionThen`
+--        advanceShoot `DoActionThen`
-        75 `DoReplicate` 
+--        75 `DoReplicate` 
-        advanceShoot `DoActionThen`
+--        advanceShoot `DoActionThen`
-        DoImpulses [ChangeStrategy WatchAndWait]
+--        DoImpulses [ChangeStrategy WatchAndWait]
-    , AimAt
+--    , AimAt
-        { _targetID = tcid
+--        { _targetID = tcid
-        , _targetSeenAt = V2 0 0 -- hack
+--        , _targetSeenAt = V2 0 0 -- hack
-        }
+--        }
-    ]
+--    ]
-  where
+--  where
-    lostest (w,cr') = canSee (_crID cr') tcid w 
+--    lostest (w,cr') = canSee (_crID cr') tcid w 
-    advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
+--    advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
-
+--
-shootAtWhileContinueTime :: Int -> World -> Creature -> Strategy
+--shootAtWhileContinueTime :: Int -> World -> Creature -> Strategy
-shootAtWhileContinueTime tcid _ _ = StrategyActions (ShootAt tcid)
+--shootAtWhileContinueTime tcid _ _ = StrategyActions (ShootAt tcid)
-    [ DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction))
+--    [ DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction))
-      `DoActionThen`
+--      `DoActionThen`
-        lostest `DoActionWhile`
+--        lostest `DoActionWhile`
-        advanceShoot `DoActionThen`
+--        advanceShoot `DoActionThen`
-        75 `DoReplicate` 
+--        75 `DoReplicate` 
-        advanceShoot `DoActionThen`
+--        advanceShoot `DoActionThen`
-        DoImpulses [ChangeStrategy WatchAndWait]
+--        DoImpulses [ChangeStrategy WatchAndWait]
-    , AimAt
+--    , AimAt
-        { _targetID = tcid
+--        { _targetID = tcid
-        , _targetSeenAt = V2 0 0 -- hack
+--        , _targetSeenAt = V2 0 0 -- hack
-        }
+--        }
-    ]
+--    ]
-  where
+--  where
-    lostest (w,cr') = canSee (_crID cr') tcid w 
+--    lostest (w,cr') = canSee (_crID cr') tcid w 
-    advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
+--    advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]

src/Dodge/Creature/SpreadGunCrit.hs

@@ -14,7 +14,7 @@ import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Perception
 import Dodge.Creature.State
 --import Dodge.Creature.State.Data
-import Dodge.Item.Weapon
+import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Consumable
 import Geometry
 import Picture

src/Dodge/Creature/State.hs

@@ -1,4 +1,7 @@
-module Dodge.Creature.State where
+module Dodge.Creature.State 
+    ( stateUpdate
+    , doDamage
+    ) where
 import Dodge.Data
 import Dodge.Data.DamageType
 import Dodge.Data.SoundOrigin
@@ -19,9 +22,6 @@ import Picture
 import qualified IntMapHelp as IM
 --import StrictHelp
 
-import Data.List
---import Data.Char
---import Data.Maybe
 import Data.Function
 import Control.Lens
 --import Control.Applicative
@@ -36,8 +36,8 @@ import Data.Monoid
 import qualified Data.Vector as V
 import qualified Data.Vector.Mutable as MV
 
-dummyUpdate :: CRUpdate
+--dummyUpdate :: CRUpdate
-dummyUpdate cr _ = (Endo id, Just cr)
+--dummyUpdate cr _ = (Endo id, Just cr)
 
 -- | The movement is updated before the ai in order to correctly set the oldpos.
 stateUpdate :: CRUpdate -> CRUpdate
@@ -73,12 +73,6 @@ setOldPos :: Creature -> Creature
 setOldPos cr = cr
     & crOldPos .~ _crPos cr
     & crOldDir .~ _crDir cr
-{- |
-Given a creature and a velocity, applies friction to that creature and evaluates a 
-velocity to carry across frames.
--}
-crFriction :: Creature -> Point2 -> Point2
-crFriction _ _ = V2 0 0
 
 --meleeCooldown :: CRUpdate -> CRUpdate
 --meleeCooldown u cr = u $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
@@ -171,64 +165,3 @@ stepReloading cr = over (crInv . ix iSel . wpReloadState) decreaseToZero cr
 decreaseToZero :: Int -> Int
 decreaseToZero x = max 0 (x - 1) 
 
-onDeath :: (Creature -> World -> World) -> CRUpdate -> CRUpdate
-onDeath h u cr w
-    | _crHP cr > 0 = u cr w
-    | otherwise    = ( Endo $ h cr , Nothing )
-
-updateBarrel 
-    :: Creature 
-    -> World
-    -> (Endo World, Maybe Creature)
-updateBarrel cr _
-    | _crHP cr > 0 = (Endo id, newCr)
-    | otherwise    = (Endo id, Nothing)
-  where 
-    newCr = Just $ doDamage cr
-
--- should generate the sparks externally using new random generators
-updateExpBarrel 
-    :: Creature 
-    -> World
-    -> (Endo World, Maybe Creature)
-updateExpBarrel cr w 
-    | _crHP cr > 0 = (Endo $ foldr (.) id pierceSparks . hiss, newCr)
-    | otherwise    = (Endo $ makeExplosionAt (_crPos cr) . stopSounds , Nothing)
-  where 
-    g = _randGen w
-    damages = _crDamage $ _crState cr
-    pierceSparks :: [World -> World]
-    pierceSparks 
-      = zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p) (Just $ _crID cr))
-                            poss as times colids
-    as =  randomRs (-0.7,0.7) g
-    colids = randomRs (0,11) g
-    times = randomRs (2,5) g
-    poss = _piercedPoints $ _crSpState $ _crState cr
-    --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages
-    newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr
-    --perforate :: DamageType -> Creature -> Creature
-    --perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints)
-    --                                                  ((:) $ int -.- _crPos cr) cr
-    --perforate _ cr = cr
-    applyFuseDamage cr' = cr' & crHP %~ 
-        subtract (length . _piercedPoints . _crSpState $ _crState cr')
-    hiss | null poss = id
-         | otherwise  = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] (_crPos cr) foamSprayLoopS (Just 1)
-    stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
-
-damToExpBarrel :: [DamageType] -> Creature -> Creature
-damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
-  where 
-    (pierceDam,otherDam) = partition isPierce ds
-    isPierce Piercing{} = True
-    isPierce _             = False
-
-damToExpBarrel' :: DamageType -> Creature -> Creature
-damToExpBarrel' (Piercing amount _ int _) cr 
-    = over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) 
-        $ over crHP (\hp -> hp - div amount 200) cr
-damToExpBarrel' PoisonDam {} cr = cr
-damToExpBarrel' SparkDam {}  cr = cr
-damToExpBarrel' PushDam{_dmPushBack = v} cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v)
-damToExpBarrel' dt             cr = cr Control.Lens.& crHP -~ _dmAmount dt

src/Dodge/Creature/State/WalkCycle.hs

@@ -1,4 +1,7 @@
 module Dodge.Creature.State.WalkCycle
+    ( updateWalkCycle
+    , footstepSideEffect
+    )
     where
 import Dodge.Data
 import Dodge.Data.SoundOrigin

src/Dodge/Creature/Test.hs

@@ -5,6 +5,17 @@ Note that the creature NEED NOT be the same as the creature with that id in the
 in fact in some cases a creature with that id may not even exist.
 -}
 module Dodge.Creature.Test
+--    ( crCanShoot
+--    , crIsAiming'
+--    , crIsReloading
+--    , crIsAiming
+--    , crHasTargetLOS
+--    , crAwayFromPost
+--    , crHasTargetR
+--    , crStratConMatchesR
+--    , crHasAmmo
+--    , crSafeDistFromTarg
+--    ) 
     where
 import Dodge.Data
 import Dodge.Base.Collide

src/Dodge/Creature/Update.hs

@@ -1,11 +1,9 @@
 module Dodge.Creature.Update
-  where
+    ( unrandUpdate
+    ) where
 import Dodge.Data
 
---import System.Random
 import Data.Monoid
--- combinators for helping with dealing with creature update
-
 
 unrandUpdate 
     :: (Creature -> World -> World) 

src/Dodge/Creature/Volition.hs

@@ -1,8 +1,13 @@
 {- | Not a good name, perhaps: internal creature actions. -}
 module Dodge.Creature.Volition
-    where
+    ( holsterWeapon
+    , drawWeapon
+    , shootTillEmpty
+    , fleeFrom
+    , shootFirstMiss
+    ) where
 import Dodge.Data
-import Dodge.Base.Collide
+--import Dodge.Base.Collide
 import Dodge.Creature.Test
 import Dodge.Creature.Stance.Data
 import Dodge.SoundLogic.LoadSound
@@ -22,17 +27,17 @@ shootTillEmpty :: Action
 shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem])
     `DoActionThen` 20 `WaitThen` holsterWeapon
 
-advanceShoot' :: Int -> Action
+--advanceShoot :: Int -> Action
-advanceShoot' tcid = lostest `DoActionWhile`
+--advanceShoot tcid = lostest `DoActionWhile`
-    advanceShoot `DoActionThen`
+--    advanceShoot' `DoActionThen`
-    75 `DoReplicate` 
+--    75 `DoReplicate` 
-    advanceShoot
+--    advanceShoot'
-  where
+--  where
-    lostest (w,cr) = canSee (_crID cr) tcid w 
+--    lostest (w,cr) = canSee (_crID cr) tcid w 
-    advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
+--    advanceShoot' = ImpulsesList [[UseItem, MoveForward 3]]
 
-shootFirstMiss' :: Action
+shootFirstMiss :: Action
-shootFirstMiss' =
+shootFirstMiss =
     LeadTarget (V2 30 50) `DoActionThen`
     DoImpulses [UseItem] `DoActionThen`
     (crCanShoot `DoActionWhile` DoActions [LeadTarget (V2 0 0),DoImpulses [UseItem]])

src/Dodge/Creature/YourControl.hs

@@ -1,10 +1,8 @@
 module Dodge.Creature.YourControl
-  where
+    ( yourControl
+    ) where
 import Dodge.Data
---import Dodge.Base
 import Dodge.Creature.Impulse.Movement
---import Dodge.Creature.State
---import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Update.UsingInput
 import Dodge.Config.KeyConfig
@@ -13,10 +11,8 @@ import Geometry
 
 import Control.Lens
 import qualified SDL
---import Data.Maybe
 import qualified Data.Set as S
 import qualified Data.IntMap.Strict as IM
---import System.Random
 import Data.Monoid
 {- | The AI equivalent for your control. -}
 yourControl 
@@ -57,26 +53,19 @@ wasdWithAiming w speed i cr
 
 wasdM :: World -> SDL.Scancode -> Point2
 wasdM w scancode 
- | scancode == moveUpKey    (_keyConfig w) = V2   0    1
+    | scancode == moveUpKey    (_keyConfig w) = V2   0    1
- | scancode == moveDownKey  (_keyConfig w) = V2   0  (-1)
+    | scancode == moveDownKey  (_keyConfig w) = V2   0  (-1)
- | scancode == moveRightKey (_keyConfig w) = V2   1    0
+    | scancode == moveRightKey (_keyConfig w) = V2   1    0
- | scancode == moveLeftKey  (_keyConfig w) = V2 (-1)   0
+    | scancode == moveLeftKey  (_keyConfig w) = V2 (-1)   0
 wasdM _ _ = V2 0 0
 
 wasdDir :: World -> Point2
 wasdDir w = foldr ((+.+) . wasdM w) (V2 0 0) $ _keys w
 
-wasdComp :: S.Set SDL.Scancode -> World -> (Point2,Maybe Float)
-wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (V2 0 0) ks
-  where
-    f (V2 0 0) = (V2 0 0, Nothing)
-    f p     = (errorNormalizeV 46 p, Just $ argV p)
-
 {- | Set posture according to mouse presses. -}
 mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
 mouseActionsCr pkeys 
     | rbPressed = crStance . posture .~ Aiming
     | otherwise = crStance . posture .~ AtEase
   where 
-    --lbPressed = SDL.ButtonLeft  `S.member` pkeys
     rbPressed = SDL.ButtonRight `S.member` pkeys

src/Dodge/Event/Keyboard.hs

@@ -83,4 +83,3 @@ toggleMap :: World -> World
 toggleMap w = w & carteDisplay %~ not
 escapeMap :: World -> World
 escapeMap w = w & carteDisplay .~ False
-

src/Dodge/Item/Weapon.hs

@@ -12,98 +12,25 @@ import Dodge.SoundLogic.LoadSound
 import Dodge.Creature.Action
 import Dodge.WorldEvent
 import Dodge.Default
---import Dodge.Default.Shell
 import Dodge.Item.Draw
---import Dodge.Particle.Bullet.HitEffect
 import Dodge.Item.Data
-import Dodge.Item.Weapon.InventoryDisplay
+import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.UseEffect
-import Dodge.Item.Weapon.Laser
-import Dodge.Item.Weapon.Bullet
-import Dodge.Item.Weapon.AmmoParams
 import Dodge.Item.Weapon.Remote
 import Dodge.Item.Attachment.Data
 import Dodge.Default.Weapon
-import Dodge.Item.Weapon.Booster
 import Dodge.Item.Weapon.Grenade
---import Dodge.Item.Attachment.Data
-import Dodge.Item.Attachment
 import Geometry
-import Geometry.Vector3D
 import Picture
 import qualified IntMapHelp as IM
 import Shape
 import ShapePicture
 
---import Data.List
---import Data.Char
 import Data.Maybe
 import Data.Function
---import qualified Data.ByteString as B
-import qualified Data.Sequence as Seq
 import Control.Lens
---import Control.Monad
-import System.Random
-
-pistol :: Item
-pistol = defaultGun 
-    { _itName = "PISTOL"
-    , _itIdentity = Pistol
-    , _wpMaxAmmo = 15
-    , _wpLoadedAmmo = 15
-    , _wpReloadTime = 40
-    , _wpReloadState = 0
-    , _itUseRate = 8
-    , _itUseTime = 0
-    , _itUse = useAmmoParams 
-    , _itUseModifiers = 
-        [ ammoCheckI
-        , hammerCheckI
-        , useTimeCheckI
-        , withSoundStart tap3S 
-        , useAmmo 1
-        , randSpreadDir
-        , withMuzFlareI
-        ]
-    , _itLeftClickUse = Nothing
-    , _wpSpread = 0.02
-    , _wpRange = 20
-    , _itHammer = HammerUp
-    , _itFloorPict = pistolPic
-    , _itAmount = 1
-    , _itMaxStack = 1
-    , _itAimingSpeed = 1
-    , _itAimingRange = 0
-    , _itZoom = defaultItZoom
-    , _itEquipPict = pictureWeaponAim pistolPic
-    , _itAttachment = NoItAttachment
-    , _itID = Nothing
-    , _itEffect = wpRecock
-    , _itInvDisplay = basicWeaponDisplay
-    , _itInvColor = white
-    , _itTargeting = Nothing
-    , _itWorldTrigger = Nothing
-    , _wpAmmo = basicBullet
-    }
-pistolPic :: Item -> SPic
-pistolPic it = 
-    ( colorSH green (prismPoly 
-        (map (addZ 3) $ rectNESW 3 3 (-3) (-3))
-        (map (addZ 0) $ rectNESW 5 3 (-5) (-7))
-    )
-    <> translateSH (V3 (-4) 5.5 4) (rotateSH pi $ bulletClip am)
-    , mempty
-    )
-  where
-    am = loadedAmmo it
-
-bulletClip :: Int -> Shape
-bulletClip x = rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW 3 0 (3 - 0.25 * am) (-5)
-  where
-    am = fromIntegral x
-
 
 effectGun :: String -> (Creature -> World -> World) -> Item
 effectGun name eff = defaultGun
@@ -115,110 +42,6 @@ autoEffectGun name eff = defaultAutoGun
     { _itName = name ++ "Gun"
     , _itUse = const eff
     }
-rezGun :: Item
-rezGun = defaultGun
-    { _itName = "REANIMATOR"
-    , _wpMaxAmmo = 50
-    , _wpLoadedAmmo = 50
-    , _wpReloadTime = 80
-    , _wpReloadState = 0
-    , _itUseRate = 0
-    , _itUseTime = 0
-    , _itUse = const aTeslaArc
-    , _itUseModifiers =
-        []
-    , _wpSpread = 0.001
-    , _wpRange = 20
-    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color chartreuse $ pictures 
-        [polygon $ rectNESW 7    3 1    (-3)
-        ,polygon $ rectNESW (-1) 3 (-7) (-3)
-        ]
-    , _itAimingSpeed = 0.4
-    , _itAimingRange = 0
-    , _itEquipPict = pictureWeaponOnAim $ \_ -> (,) emptySH $ color chartreuse $ pictures 
-        [polygon $ rectNESW 7    3 1    (-3)
-        ,polygon $ rectNESW (-1) 3 (-7) (-3)
-        ]
-    }
-teslaGun :: Item
-teslaGun = defaultGun 
-    { _itName = "TESLA"
-    , _itIdentity = TeslaGun
-    , _wpMaxAmmo = 200
-    , _wpLoadedAmmo = 200
-    , _wpReloadTime = 80
-    , _wpReloadState = 0
-    , _itUseRate = 0
-    , _itAimStance = TwoHandFlat
-    , _itUseTime = 0
-    , _itUse = const aTeslaArc
-    , _itUseModifiers =
-        [ ammoCheckI
-        , useTimeCheckI
-        , withTempLight 1 100 (V3 0 0 1)
-        , withSoundForI elecCrackleS 1
-        , useAmmo 1
-        ]
-    , _wpSpread = 0.001
-    , _wpRange = 20
-    , _itFloorPict = teslaGunPic
-    , _itAimingSpeed = 0.4
-    , _itZoom = defaultItZoom
-    , _itAimingRange = 0
-    , _itEquipPict = pictureWeaponOnAim teslaGunPic
-    }
-teslaGunPic :: Item -> SPic
-teslaGunPic _ = 
-    ( colorSH blue $
-        upperPrismPoly 5 (rectNESW xb    y xa    (-y))
-        ++ upperPrismPoly 5 (rectNESW (-xa) y (-xb) (-y))
-    , mempty
-    )
-  where
-    xa = 1
-    xb = 9
-    y = 4
-lasGun :: Item
-lasGun = defaultAutoGun 
-    { _itName = "LASGUN ////"
-    , _itIdentity = LasGun
-    , _wpMaxAmmo = 200
-    , _wpLoadedAmmo = 200
-    , _wpReloadTime = 80
-    , _wpReloadState = 0
-    , _itUseRate = 0
-    , _itUseTime = 0
-    , _itUse = const aLaser
-    , _itUseModifiers =
-        [ ammoCheckI
-        , useTimeCheckI
-        , withTempLight 1 100 (V3 1 1 0)
-        , withSoundForI tone440sawtoothS 1
-        , useAmmo 1
-        ]
-    , _wpSpread = 0.001
-    , _wpRange = 20
-    , _itFloorPict = lasGunPic
-    , _itAimingSpeed = 0.4
-    , _itAimingRange = 1
-    , _itEquipPict = pictureWeaponOnAim lasGunPic
-    , _itAttachment = ItCharMode $ Seq.fromList "/VZ"
-    , _itScroll   = scrollCharMode
-    , _itInvDisplay = basicWeaponDisplay
-    }
-lasGunPic :: Item -> SPic
-lasGunPic it = 
-    ( colorSH blue $ 
-        upperPrismPoly 4 (rectNESW 3 15 1 (-15))
-        <> upperPrismPoly 4 (rectNESW (-1) 15 (-3) (-15))
-        -- <> (upperPrismPoly 4 $ rectNESW (5) l (-5) (l-2))
-        <> upperPrismPoly 1 (rectNESW 3 15 (-3) (-15))
-    , setLayer 1 . color col . setDepth 1.1 . polygon $ rectNESW 1 15 (-1) (-15)
-    )
-  where
-    amFrac = fractionLoadedAmmo it
-    col = brightX 2 1.5 $ mixColors amFrac (1-amFrac) green red
-
 forceFieldGun :: Item
 forceFieldGun = defaultGun 
     { _itName = "FORCEFIELD"
@@ -255,30 +78,6 @@ forceFieldGun = defaultGun
 --     , _itAimingSpeed = 1
 --     , _itAimingRange = 0.5
 --     }
-tractorGun :: Item
-tractorGun = defaultAutoGun 
-    { _itName = "TRACTORGUN"
-    , _itIdentity = TractorGun
-    , _wpMaxAmmo = 10000
-    , _wpLoadedAmmo = 10000
-    , _wpReloadTime = 40
-    , _wpReloadState = 0
-    , _itUseRate = 0
-    , _itUseTime = 0
-    , _itUse = aTractorBeam
-    , _itUseModifiers =
-        [ ammoUseCheckI
-        ]
-    , _wpSpread = 0.00001
-    , _wpRange = 20
-    , _itFloorPict = tractorGunSPic
-    , _itAimingSpeed = 0.4
-    , _itAimingRange = 0.5
-    , _itEquipPict = pictureWeaponOnAim tractorGunSPic
-    }
--- TODO own picture for tractor gun
-tractorGunSPic :: Item -> SPic
-tractorGunSPic = lasGunPic
 
 removeItAttachment :: Int -> Int -> World -> World
 removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ NoItAttachment
@@ -286,379 +85,6 @@ removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachmen
     cr = _creatures w IM.! i
     itRef = _crInvSel cr
 
-hvAutoGun :: Item
-hvAutoGun = defaultAutoGun 
-    { _itName = "AUTO-HV"
-    , _itIdentity = HvAutoGun
-    , _wpMaxAmmo = 100
-    , _wpLoadedAmmo = 100
-    , _wpReloadTime = 200
-    , _wpReloadState = 0
-    , _itUseRate = 25
-    , _itUseTime = 0
-    , _itUse = useAmmoParams
-    , _itUseModifiers =
-        [ ammoCheckI
-        , rateIncABI 24 7 (torqueBeforeAtLeast 0.1 0.1) (torqueAfterI 0.2)
-        , withSoundStart bangEchoS
-        , withThinSmokeI
-        , withMuzFlareI
-        ]
-    , _wpRange = 20
-    , _itFloorPict = hvAutoGunPic
-    , _itAimingSpeed = 0.2
-    , _itAimingRange = 1
-    , _itEquipPict = pictureWeaponOnAim hvAutoGunPic
-    , _wpAmmo = hvBullet
-    }
-hvAutoGunPic :: Item -> SPic
-hvAutoGunPic it = 
-    ( colorSH orange (prismPoly
-        (map (addZ 5) $ rectNESW 3 12 (-3) (-8))
-        (map (addZ 0) $ rectNESW 5 12 (-5) (-12))
-        )
-    <> bulletClip am
-    , mempty
-    )
-  where
-    am = loadedAmmo it
-ltAutoGun :: Item                           
-ltAutoGun = defaultAutoGun 
-    { _itName = "AUTO-LT"
-    , _itIdentity = LtAutoGun
-    , _wpMaxAmmo = 25
-    , _wpLoadedAmmo = 25
-    , _wpReloadTime = 80
-    , _wpReloadState = 0
-    , _itUseRate = 3
-    , _itUseTime = 0
-    , _itUse = useAmmoParams
-    , _itUseModifiers = 
-        [ ammoCheckI
-        , useTimeCheckI
-        , withSoundStart tap1S
-        , useAmmo 1
-        , withRandomDirI 0.1
-        , torqueAfterI 0.2
-        , withSidePushI 50
-        , modClock 2 withMuzFlareI
-        ]
-    , _wpSpread = 0.5
-    , _wpRange = 20
-    , _itFloorPict = ltAutoGunPic
-    , _itAimingSpeed = 1
-    , _itAimingRange = 0
-    , _itZoom = defaultItZoom
-    , _itEquipPict = pictureWeaponOnAim ltAutoGunPic    
-    , _itAimStance = OneHand
-    , _wpAmmo = ltBullet
-    }
-ltAutoGunPic :: Item -> SPic
-ltAutoGunPic it = 
-    ( colorSH green $ prismPoly 
-        (map (addZ 5) $ mirrorXAxis [V2 (-2) 3, V2 5 3, V2 10 0])
-        (map (addZ 0) $ mirrorXAxis [V2 (-5) 5, V2 5 5, V2 10 0])
-        <> bulletClip am
-    , mempty
-    )
-  where
-    am = loadedAmmo it
-miniGun :: Item
-miniGun = defaultAutoGun 
-    { _itName = "MINI-G"
-    , _itIdentity = MiniGun
-    , _wpMaxAmmo = 1500
-    , _wpLoadedAmmo = 1500
-    , _wpReloadTime = 200
-    , _wpReloadState = 0
-    , _wpMaxWarmUp = 100
-    , _itUseRate = 0
-    , _itUseTime = 0
-    , _itUse = useAmmoParamsVelMod vm4
-    , _itUseModifiers =
-        [ ammoCheckI
-        , withWarmUpI crankSlowS
-        , useTimeCheckI
-        --, afterRecoil recoilAmount
-        , withSoundForI mini1S 2
-        --, withThinSmokeI
-        , torqueAfterI 0.05
-        , withSidePushI 53
-        , afterRecoil recoilAmount
-        , withRandomOffsetI 12
-        , trigDoAlso (useAmmoParamsVelMod vm1)
-        --, torqueBeforeForcedI 0.001
-        , withSidePushI 52
-        , afterRecoil recoilAmount
-        , withRandomOffsetI 11
-        , withOldDir od1
-        , trigDoAlso (useAmmoParamsVelMod vm2)
-        --, torqueBeforeForcedI 0.001
-        , withSidePushI 51
-        , afterRecoil recoilAmount
-        , withRandomOffsetI 10
-        , withOldDir od2
-        , trigDoAlso (useAmmoParamsVelMod vm3)
-        , useAmmo 4
-        --, torqueBeforeForcedI 0.001
-        , withSidePushI 50
-        , afterRecoil recoilAmount
-        , withRandomOffsetI 9
-        , withMuzFlareI
-        , withOldDir od3
-        , withSmoke 1 black 20 200 5
-        ]
-    , _wpRange = 20
-    , _itFloorPict = miniGunPictItem
-    , _itAimingSpeed = 0.4
-    , _itAimingRange = 1
-    , _itEquipPict = pictureWeaponAim miniGunPictItem
-    , _wpAmmo = basicBullet
-    }
-  where
-    recoilAmount = 5
-    [vm1,vm2,vm3,vm4] = 
-        [ 0.25
-        , 0.5
-        , 0.75
-        , 1
-        ]
-    [od1,od2,od3] = 
-        [ 0.25, 0.5, 0.9]
-        --[ 0.75, 0.5, 0.25]
-        --[ 0, 0, 0]
-miniGunPictItem :: Item -> SPic
-miniGunPictItem it = miniGunPict spin (loadedAmmo it)
-  where
-    spin = (-10) * _wpLoadedAmmo it + _wpCurWarmUp it
-
-miniGunPict :: Int -> Int -> SPic
-miniGunPict spin am = 
-    (   colorSH red (rotateSHx a barrels)
-        <> colorSH red (upperPrismPoly 5 $ rectNESW 8 8 (-8) 4)
-        <> colorSH red (prismPoly 
-                (map (addZ 5) $ rectNESW 2 12 (-2) (-12))
-                (map (addZ 0) $ rectNESW 4 12 (-4) (-16))
-            )
-        <> clip (-1) 0
-        <> clip (-7) 0
-    , mempty
-    )
-  where
-    aBarrel = translateSH (V3 7 0 9) $ prismPoly
-        (map (addZ 5) $ rectNESW 2 12 (-2) (-1))
-        (map (addZ 0) $ rectNESW 4 12 (-4) (-5))
-    barrels = concatMap (\an -> aBarrel & rotateSHx an) [0,0.5* pi, pi, 1.5*pi]
-    a = fromIntegral spin / 100
-    x = fromIntegral am / 10
-    clip y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4) 
-        . upperPrismPoly 2 
-        $ rectNESW (negate $ 3 + 0.25 * x) y 3 (y-5))
-spreadGun :: Item
-spreadGun = defaultGun 
-    { _itName = "SPREAD"
-    , _itIdentity = SpreadGun
-    , _wpMaxAmmo = 5
-    , _wpLoadedAmmo = 5
-    , _wpReloadTime = 80
-    , _wpReloadState = 0
-    , _itUseRate = 20
-    , _itUseTime = 0
-    --, _itUse = \_ -> spreadNumVelWthHiteff spreadGunSpread 9 (V2 30 0) 2 basicBulletEffect
-    , _itUse = useAmmoParams
-    , _itUseModifiers =
-        [ ammoCheckI
-        , hammerCheckI
-        , useTimeCheckI
-        , withSoundStart shotgunS
-        , useAmmo 1
-        , withRecoilI 100
-        , withMuzFlareI
-        , spreadNumI
-        ]
-    , _wpSpread = spreadGunSpread
-    , _wpRange = 20
-    , _itFloorPict = spreadGunPic
-    , _itAimingSpeed = 1
-    , _itAimingRange = 0
-    , _itEquipPict = pictureWeaponOnAim spreadGunPic
-    , _wpAmmo = basicBullet
-    , _wpNumBarrels = 50
-    }
-spreadGunPic :: Item -> SPic
-spreadGunPic it = 
-    ( colorSH green (upperPrismPoly 5 $ map toV2[(-3,0),(3,6),(3,-6)])
-    <> bulletClip am
-    , mempty
-    )
-  where
-    am = loadedAmmo it
-multGun :: Item
-multGun = defaultGun 
-    { _itName = "MULTGUN"
-    , _itIdentity = MultGun
-    , _wpMaxAmmo = 2
-    , _wpLoadedAmmo = 2
-    , _wpReloadTime = 40
-    , _wpReloadState = 0
-    , _itUseRate = 20
-    , _itUseTime = 0
-    , _itUse = useAmmoParams
-    , _itUseModifiers =
-        [ ammoCheckI
-        , hammerCheckI
-        , useTimeCheckI
-        , withSoundStart shotgunS
-        , useAmmo 1
-        , withRecoilI 200
-        , withMuzFlareI
-        , numI
-        ]
-    , _wpSpread = spreadGunSpread
-    , _wpRange = 20
-    , _itFloorPict = multGunSPic
-    , _itAimingSpeed = 0.4
-    , _itAimingRange = 1
-    , _itZoom       = defaultItZoom
-    , _itAimZoom    = defaultItZoom {_itZoomFac = 1.5}
-    , _itEquipPict = pictureWeaponOnAim multGunSPic
-    , _itAimStance = TwoHandTwist
-    , _wpAmmo = basicBullet
-    , _wpNumBarrels = 5
-    }
-multGunSPic :: Item -> SPic
-multGunSPic it = 
-    ( colorSH red (
-        upperPrismPoly 2 (rectNESW 4 8 (-4) (-12)) <>
-        translateSHf 8 0 (concatMap barrel [12,7,2,-3,-8] <> 
-            upperPrismPoly 2 (map toV2 [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)])
-            )
-    ) <> bulletClip am
-    , mempty
-    )
-  where
-    barrel y = prismPoly 
-        (map (addZ 5) $ rectNSEW y (y-4) 2   0 )
-        (map (addZ 0) $ rectNSEW y (y-4) 2 (-2))
-    am = loadedAmmo it
-longGun :: Item
-longGun = defaultGun 
-    { _itName = "LONGGUN"
-    , _itIdentity = LongGun
-    , _wpMaxAmmo = 1
-    , _wpLoadedAmmo = 1
-    , _wpReloadTime = 100
-    , _wpReloadState = 0
-    , _wpReloadType = PassiveReload skwareFadeTwoSecS
-    , _itUseRate = 100
-    , _itUseTime = 0
-    , _itUse = useAmmoParams
-    , _itUseModifiers =
-        [ ammoCheckI
-        , hammerCheckI
-        , useTimeCheckI
-        , withSoundStart bangEchoS
-        , useAmmo 1
-        , withThickSmokeI
-        , torqueAfterI 0.05
-        , withMuzFlareI
-        ]
-    , _wpRange = 200
-    , _itFloorPict = longGunSPic
-    , _itAimingSpeed = 0.2
-    , _itAimingRange = 1
-    , _itZoom       = defaultItZoom 
-    , _itAimZoom    = defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}
-    , _itEquipPict = pictureWeaponOnAim longGunSPic
-    , _itScroll = zoomLongGun
-    , _itAttachment = ItScope (V2 0 0) 0 1 False
-    , _itEffect = itemLaserScopeEffect
-    , _wpAmmo = hvBullet
-    , _itAimStance = TwoHandTwist
-    }
-longGunSPic :: Item -> SPic
-longGunSPic _ =
-    ( colorSH orange $ upperPrismPoly 5 $ rectWH 12 2
-    , mempty
-    )
-
-zoomLongGun :: Float -> Creature -> Item -> Item
-zoomLongGun x _
-    | x > 0 = startZoomInLongGun 
-    | x < 0 = startZoomOutLongGun
-    | otherwise = id
-
-startZoomInLongGun :: Item -> Item
-startZoomInLongGun   = itAttachment . scopeZoomChange %~ \x -> max 5 (x + 5)
-startZoomOutLongGun :: Item -> Item
-startZoomOutLongGun  = itAttachment . scopeZoomChange %~ \x -> min (-5) (x-5)
-poisonSprayer :: Item
-poisonSprayer = defaultAutoGun 
-    { _itName = "POISON"
-    , _itIdentity = PoisonSprayer
-    , _wpMaxAmmo = 500
-    , _wpLoadedAmmo = 500
-    , _wpReloadTime = 100
-    , _wpReloadState = 0
-    , _itUseRate = 0
-    , _itUseTime = 0
-    , _itUse = const aGasCloud 
-    , _itUseModifiers =
-        [ ammoCheckI
-        , useTimeCheckI
-        , withSoundForI foamSprayLoopS 5
-        , useAmmo 1
-        , spreadNumI
-        ]
-    , _wpRange = 8
-    , _itFloorPict = flamerPic
-    , _itAimingSpeed = 0.2
-    , _itAimingRange = 0
-    , _itZoom = defaultItZoom
-    , _itEquipPict = pictureWeaponOnAim flamerPic
-    , _wpSpread = 0.1
-    , _wpNumBarrels = 3
-    }
-flamer :: Item
-flamer = defaultAutoGun 
-    { _itName = "FLAMER"
-    , _itIdentity = Flamethrower
-    , _wpMaxAmmo = 250
-    , _wpLoadedAmmo = 250
-    , _wpReloadTime = 100
-    , _wpReloadState = 0
-    , _itUseRate = 0
-    , _itUseTime = 0
-    , _itUse = \_ -> randWalkAngle 0.2 0.01 aFlame
-    , _itUseModifiers =
-        [ ammoUseCheckI
-        , withSidePushI 5
-        --, withTempLight 1 100 (V3 1 0 0)
-        , withSidePushAfterI 20
-        ]
-    , _wpSpread = 0
-    , _wpRange = 8
-    , _itFloorPict = flamerPic
-    , _itAimingSpeed = 0.5
-    , _itAimingRange = 0
-    , _itZoom       = defaultItZoom
-    , _itAimZoom    = defaultItZoom {_itZoomMax = 5, _itZoomMin = 1.5}
-    , _itEquipPict = pictureWeaponOnAim flamerPic
-    , _itAttachment = NoItAttachment
-    }
-flamerPic :: Item -> SPic
-flamerPic it = 
-    ( colorSH yellow $ 
-        translateSHf tx ty (upperPrismPoly tz $ polyCirc 3 r)
-        ++ upperPrismPoly 5 (rectNESW 2 9 (-2) (-9))
-    , color black $ translate3 (V3 tx ty (tz+0.01)) $ circleSolid (r * am)
-    )
-  where
-    tx = - 5
-    ty = - 6
-    tz = 3
-    r = 5
-    am = fractionLoadedAmmo2 it
 blinkGun :: Item
 blinkGun = defaultGun 
     { _itName = "BLINKER"
@@ -681,62 +107,11 @@ blinkGun = defaultGun
     , _itAimingSpeed = 1
     , _itAimingRange = 0
     }
-boosterGun :: Item
-boosterGun = defaultGun 
-    { _itName = "BOOSTER"
-    , _itIdentity = Blinker
-    , _wpMaxAmmo = 100
-    , _wpLoadedAmmo = 100
-    , _wpReloadTime = 20
-    , _wpReloadState = 0
-    , _itUseRate = 0
-    , _itUseTime = 0
-    , _itUse = \_ -> boostSelf 10
-    , _itLeftClickUse = Just $ boostSelfL 10
-    , _wpSpread = 0.05
-    , _wpRange = 20
-    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
-    , _itAimingSpeed = 1
-    , _itAimingRange = 0
-    , _itEffect = resetAttachmentID
-    }
-
-aTeslaArc :: Creature -> World -> World
-aTeslaArc cr w 
-    = -- teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
-    set randGen g w
-    & particles %~ (makeTeslaArcAt col pos dir :)
-  where 
-    pos = _crPos cr +.+ (_crRad cr +1) *.* unitVectorAtAngle dir
-    dir = _crDir cr
-    (colid,g) = randomR (0::Int,3) $ _randGen w
-    col = chooseColor colid
-    chooseColor 0 = white
-    chooseColor 1 = azure
-    chooseColor 2 = blue
-    chooseColor _ = cyan
 
 
 shellExplosionAt :: Point2 -> World -> World
 shellExplosionAt = makeExplosionAt
 
-aGasCloud :: Creature -> World -> World
-aGasCloud cr w = insertCloud $ set randGen g w
-  where 
-    (a,g) = randomR (-0.1,0.1) (_randGen w)
-    dir = _crDir cr + a
-    pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
-    vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir
-    insertCloud = makeGasCloud pos vel
-
-aFlame :: Creature -> World -> World
-aFlame cr w = w & particles %~ (aFlameParticle t pos vel (Just cid) :)
-  where 
-    (t,_) = randomR (99,101) (_randGen w)
-    cid = _crID cr
-    dir = _crDir cr
-    pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
-    vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
     
 aSelf :: Creature -> World -> World
 aSelf = blinkAction
@@ -808,57 +183,6 @@ setRemoteBombScope itid pj w' = case _itemPositions w' IM.! itid of
               & creatures . ix cid . crInv . ix invid . itAimZoom 
                     .~ (defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5})
     _   -> w'
-                        
-grenade :: Item
-grenade = Throwable
-    { _itName = "GRENADE " ++ show fuseTime
-    , _itIdentity = Grenade
-    , _itMaxStack = 8
-    , _itAmount = 1
-    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
-    , _twMaxRange = 150
-    , _twAccuracy = 30
-    , _itUse = \_ -> throwGrenade makeExplosionAt
-    , _itUseModifiers =
-        [ useTimeCheckI
-        ]
-    , _itAimingSpeed = 1
-    , _itAimingRange = 0
-    , _itZoom       = defaultItZoom
-    , _itAimZoom    = defaultItZoom {_itZoomMax = f fuseTime, _itZoomMin = f fuseTime}
-    , _itEquipPict = pictureWeaponOnAim $ \_ -> grenadePic fuseTime
-    , _itID = Nothing
-    , _itUseRate = 25 
-    , _itUseTime = 0
-    , _itAttachment = ItFuse fuseTime
-    , _itInvColor = white
-    , _itInvDisplay = basicWeaponDisplay
-    , _itEffect = wpRecock
-    , _itHammer = HammerUp
-    , _itScroll = changeFuse
-    , _itAimStance = OneHand
-    }
-  where 
-    fuseTime = 50
-    f x = 50 / fromIntegral x
-
-flameGrenade :: Item
-flameGrenade = grenade {
-     _itName = "FLMGREN " ++ show fuseTime
-     , _itUse = \_ -> throwGrenade makeFlameExplosionAt
-    }
-  where 
-    fuseTime = 50 :: Int
-    --f x = 50 / fromIntegral x
-
-teslaGrenade :: Item
-teslaGrenade = grenade {
-     _itName = "TLSGREN " ++ show fuseTime
-     , _itUse = \_ -> throwGrenade makeTeslaExplosionAt
-    }
-  where 
-    fuseTime = 50 :: Int
-    --f x = 50 / fromIntegral x
 
 defaultThrowable :: Item
 defaultThrowable = grenade
@@ -868,7 +192,8 @@ remoteBomb = defaultThrowable
     , _itIdentity = RemoteBomb
     , _itMaxStack = 1
     , _itAmount = 1
-    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
+    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 
+        [(-3,-3),(-3,3),(3,3),(3,-3)]
     , _twMaxRange = 150
     , _twAccuracy = 30
     , _itUse = const throwRemoteBomb
@@ -944,9 +269,6 @@ remoteBombPic _ = pictures
 remoteBombUnarmedPic :: Picture
 remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
 
-spreadGunSpread,autogunSpread :: Float
-spreadGunSpread = 0.5
-autogunSpread = 0.07
 pipe :: Item
 pipe = Craftable
     { _itIdentity = Generic

src/Dodge/Item/Weapon/AmmoParams.hs

@@ -1,5 +1,10 @@
 module Dodge.Item.Weapon.AmmoParams
-    where
+    ( useAmmoParams
+    , loadedAmmo
+    , useAmmoParamsVelMod
+    , fractionLoadedAmmo
+    , fractionLoadedAmmo2
+    ) where
 import Dodge.Data
 import Dodge.Particle.Bullet.Spawn
 import Geometry

src/Dodge/Item/Weapon/AutoGun.hs

@@ -1,80 +0,0 @@
-module Dodge.Item.Weapon.AutoGun
-    where
-import Dodge.Data
-import Dodge.Default.Weapon
-import Dodge.Default
-import Dodge.Item.Attachment
-import Dodge.Item.Attachment.Data
-import Dodge.Item.Weapon.ExtraEffect
-import Dodge.Item.Weapon.InventoryDisplay
-import Dodge.Item.Weapon.AmmoParams
-import Dodge.Item.Data
-import Dodge.Item.Draw
-import Dodge.Item.Weapon.Bullet
-import Dodge.Item.Weapon.TriggerType
-import Dodge.SoundLogic.LoadSound
-import Picture
-import Geometry
-import Geometry.Vector3D
-import ShapePicture
-import Shape
-
-import qualified Data.Sequence as Seq
-
-autoGun :: Item
-autoGun = defaultAutoGun 
-    { _itName = "AUTOGUN"
-    , _itIdentity = AutoGun
-    , _wpMaxAmmo = 30
-    , _wpLoadedAmmo = 30
-    , _wpReloadTime = 80
-    , _wpReloadState = 0
-    , _itUseRate = 5
-    , _itUseTime = 0
-    , _itUse   = useAmmoParams
-    , _itUseModifiers =
-        [ ammoCheckI
-        , charFiringStratI
-            [('S', hammerCheckI)
-            ]
-        , useTimeCheckI
-        , charFiringStratI
-            [('M', torqueBefore 0.08) 
-            ,('S', torqueBefore 0.05) 
-            ]
-        , withSoundForI autoBS 5
-        , useAmmo 1
-        , withRandomDirI (autogunSpread/2)
-        , withMuzFlareI
-        , withSmoke 1 black 20 200 5
-        ]
-    , _wpSpread = autogunSpread
-    , _wpRange = 20
-    , _itHammer = HammerUp
-    , _itFloorPict = autoGunPic
-    , _itAimingSpeed = 0.4
-    , _itAimingRange = 1
-    , _itZoom = defaultItZoom 
-    , _itAimZoom = defaultItZoom {_itZoomFac = 1.5}
-    , _itEquipPict = pictureWeaponOnAim autoGunPic
-    , _itEffect = wpRecock
-    , _itAttachment = ItCharMode $ Seq.fromList "MS"
-    , _itScroll   = scrollCharMode
-    , _itInvDisplay = basicWeaponDisplay
-    , _wpAmmo = basicBullet    
-    }
-autoGunPic :: Item -> SPic
-autoGunPic it =
-    ( colorSH red (prismPoly 
-        (map (addZ 5) $ rectNESW 2 12 (-2) (-8))
-        (map (addZ 0) $ rectNESW 4 12 (-4) (-12))
-        )
-    <> translateSHf 0 (-1) (rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW (negate $ 3 + 0.25 * x) 0 3 (-5))
-    , mempty
-    )
-  where
-    x = fromIntegral $ loadedAmmo it
-
-autogunSpread :: Float
-autogunSpread = 0.07
-

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -0,0 +1,315 @@
+module Dodge.Item.Weapon.BatteryGuns
+    ( lasGun
+    , teslaGun
+    , tractorGun
+    )
+    where
+import Dodge.Data
+import Dodge.SoundLogic.LoadSound
+import Dodge.Creature.State.Data
+import Dodge.Data.DamageType
+import Dodge.WorldEvent
+import Dodge.Default
+import Dodge.Item.Draw
+import Dodge.Item.Data
+import Dodge.Item.Weapon.InventoryDisplay
+import Dodge.Item.Weapon.TriggerType
+import Dodge.Item.Weapon.AmmoParams
+import Dodge.Item.Attachment.Data
+import Dodge.Default.Weapon
+import Dodge.Item.Attachment
+import Dodge.WorldEvent.HelperParticle
+import Dodge.Base
+import Dodge.Zone
+import Geometry
+import Picture
+import Shape
+import ShapePicture
+import Dodge.Picture
+
+import Data.Function
+import qualified Data.Sequence as Seq
+import Data.List
+import Control.Lens
+import System.Random
+import Data.Maybe
+import Data.Tuple
+import qualified Data.IntMap.Strict as IM
+teslaGun :: Item
+teslaGun = defaultGun 
+    { _itName = "TESLA"
+    , _itIdentity = TeslaGun
+    , _wpMaxAmmo = 200
+    , _wpLoadedAmmo = 200
+    , _wpReloadTime = 80
+    , _wpReloadState = 0
+    , _itUseRate = 0
+    , _itAimStance = TwoHandFlat
+    , _itUseTime = 0
+    , _itUse = const aTeslaArc
+    , _itUseModifiers =
+        [ ammoCheckI
+        , useTimeCheckI
+        , withTempLight 1 100 (V3 0 0 1)
+        , withSoundForI elecCrackleS 1
+        , useAmmo 1
+        ]
+    , _wpSpread = 0.001
+    , _wpRange = 20
+    , _itFloorPict = teslaGunPic
+    , _itAimingSpeed = 0.4
+    , _itZoom = defaultItZoom
+    , _itAimingRange = 0
+    , _itEquipPict = pictureWeaponOnAim teslaGunPic
+    }
+teslaGunPic :: Item -> SPic
+teslaGunPic _ = 
+    ( colorSH blue $
+        upperPrismPoly 5 (rectNESW xb    y xa    (-y))
+        ++ upperPrismPoly 5 (rectNESW (-xa) y (-xb) (-y))
+    , mempty
+    )
+  where
+    xa = 1
+    xb = 9
+    y = 4
+lasGun :: Item
+lasGun = defaultAutoGun 
+    { _itName = "LASGUN ////"
+    , _itIdentity = LasGun
+    , _wpMaxAmmo = 200
+    , _wpLoadedAmmo = 200
+    , _wpReloadTime = 80
+    , _wpReloadState = 0
+    , _itUseRate = 0
+    , _itUseTime = 0
+    , _itUse = const aLaser
+    , _itUseModifiers =
+        [ ammoCheckI
+        , useTimeCheckI
+        , withTempLight 1 100 (V3 1 1 0)
+        , withSoundForI tone440sawtoothS 1
+        , useAmmo 1
+        ]
+    , _wpSpread = 0.001
+    , _wpRange = 20
+    , _itFloorPict = lasGunPic
+    , _itAimingSpeed = 0.4
+    , _itAimingRange = 1
+    , _itEquipPict = pictureWeaponOnAim lasGunPic
+    , _itAttachment = ItCharMode $ Seq.fromList "/VZ"
+    , _itScroll   = scrollCharMode
+    , _itInvDisplay = basicWeaponDisplay
+    }
+lasGunPic :: Item -> SPic
+lasGunPic it = 
+    ( colorSH blue $ 
+        upperPrismPoly 4 (rectNESW 3 15 1 (-15))
+        <> upperPrismPoly 4 (rectNESW (-1) 15 (-3) (-15))
+        -- <> (upperPrismPoly 4 $ rectNESW (5) l (-5) (l-2))
+        <> upperPrismPoly 1 (rectNESW 3 15 (-3) (-15))
+    , setLayer 1 . color col . setDepth 1.1 . polygon $ rectNESW 1 15 (-1) (-15)
+    )
+  where
+    amFrac = fractionLoadedAmmo it
+    col = brightX 2 1.5 $ mixColors amFrac (1-amFrac) green red
+
+tractorGun :: Item
+tractorGun = defaultAutoGun 
+    { _itName = "TRACTORGUN"
+    , _itIdentity = TractorGun
+    , _wpMaxAmmo = 10000
+    , _wpLoadedAmmo = 10000
+    , _wpReloadTime = 40
+    , _wpReloadState = 0
+    , _itUseRate = 0
+    , _itUseTime = 0
+    , _itUse = aTractorBeam
+    , _itUseModifiers =
+        [ ammoUseCheckI
+        ]
+    , _wpSpread = 0.00001
+    , _wpRange = 20
+    , _itFloorPict = tractorGunSPic
+    , _itAimingSpeed = 0.4
+    , _itAimingRange = 0.5
+    , _itEquipPict = pictureWeaponOnAim tractorGunSPic
+    }
+-- TODO own picture for tractor gun
+tractorGunSPic :: Item -> SPic
+tractorGunSPic = lasGunPic
+
+aTeslaArc :: Creature -> World -> World
+aTeslaArc cr w = set randGen g w
+    & particles %~ (makeTeslaArcAt col pos dir :)
+  where 
+    pos = _crPos cr +.+ (_crRad cr +1) *.* unitVectorAtAngle dir
+    dir = _crDir cr
+    (colid,g) = randomR (0::Int,3) $ _randGen w
+    col = chooseColor colid
+    chooseColor 0 = white
+    chooseColor 1 = azure
+    chooseColor 2 = blue
+    chooseColor _ = cyan
+
+aLaser :: Creature -> World -> World
+aLaser cr = particles %~ (makeLaserAt phaseV pos dir : )
+  where 
+    pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) 
+    dir = _crDir cr
+    phaseV = charToPhaseV 
+        $ fromMaybe '/' $ Seq.lookup 0 =<< cr ^? crInv . ix j . itAttachment . itCharMode
+    j = _crInvSel cr
+
+charToPhaseV :: Fractional p => Char -> p
+charToPhaseV 'V'    = 0.2
+charToPhaseV '/'   = 1
+charToPhaseV 'Z'    = 5
+charToPhaseV _ = error "Trying to set an undefined phaseV"
+
+makeLaserAt :: Float -> Point2 -> Float -> Particle
+makeLaserAt phaseV pos dir = Particle
+    { _ptDraw = const blank
+    , _ptUpdate = moveLaser phaseV pos dir
+    }
+moveLaser 
+    :: Float    -- ^ Phase velocity, controls deflection through windows
+    -> Point2 
+    -> Float 
+    -> World 
+    -> Particle 
+    -> (World, Maybe Particle)
+moveLaser phaseV pos dir w pt
+    = ( hitEffect w
+      , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
+      )
+  where 
+    xp = pos +.+ 800 *.* unitVectorAtAngle dir
+    reflectDir wall = argV (reflectIn (uncurry (-.-) (_wlLine wall)) (xp -.- pos))
+    f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either Creature Wall),[Point2])
+    f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of
+        Just (p,Right wl) 
+            | _wlIsSeeThrough wl -> f' p $ f (wl:seenWs) p (h x y wl p)
+            | otherwise -> (Just (p,Right wl), [p])
+        Just (p,obj) -> (Just (p,obj), [p])
+        Nothing -> (Nothing, [y])
+    f' p (x,ps') = (x,p:ps')
+    h x y wl p 
+        | isEntering = p +.+ rotateV angleRef normalDist
+        | otherwise = p +.+ rotateV angleRef' normalDist'
+      where 
+        wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl)
+        normalDist = magV (p -.- y) *.* normalizeV wlNormal
+        angleInc = piRange $ argV wlNormal - argV (x -.- y)
+        angleRef 
+            | reflectExternal = angleInc
+            | otherwise = asin $ sin angleInc / phaseV
+        piRange a' 
+            | a' > pi = a' - 2 * pi
+            | a' > negate pi = a'
+            | otherwise  = a' + 2 * pi
+        isEntering = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl))
+        wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl)
+        normalDist' = magV (p -.- y) *.* normalizeV wlNormal'
+        angleInc' = piRange $ argV wlNormal' - argV (x -.- y)
+        angleRef' 
+            | reflectInternal = angleInc'
+            | otherwise = asin $ phaseV * sin angleInc'
+        reflectInternal = 1 < abs (phaseV * sin angleInc')
+        reflectExternal = 1 < abs (sin angleInc / phaseV)
+            
+    h' ws (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws
+    h' _ _ = True
+    (thHit, ps) = f [] pos xp
+    hitEffect
+      = case thHit of
+          Just (p,Left cr) 
+              -> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 19 pos p xp)
+          Just (p,Right wl) -> colSpark 8 (V4 20 (-5) 0 1) (p +.+ safeNormalizeV (pos -.- p))
+                                                      (reflectDir wl)
+          _   -> id
+    pic = setLayer 1 $ pictures
+        [ setDepth 19   . color (brightX 0 0.5 yellow) $ lineOfThickness 20 (pos:ps)
+        , setDepth 19.5 . color (brightX 10 1 yellow)  $ lineOfThickness 3  (pos:ps)
+        ]
+
+aTractorBeam :: Item -> Creature -> World -> World
+aTractorBeam _ cr w = over props (IM.insert i (tractorBeamAt i spos outpos dir)) w
+  where 
+    i = newProjectileKey w
+    cpos = _crPos cr
+    spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
+    xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
+    dir = _crDir cr
+    outpos = collidePointWalls cpos xpos
+        $ wallsAlongLine cpos xpos w
+
+tractorBeamAt :: Int -> Point2 -> Point2 -> Float -> Prop
+tractorBeamAt i pos outpos dir = ProjectileTimed
+    { _pjPos = pos
+    , _pjStartPos = outpos
+    , _pjVel = d
+    , _prDraw = tractorSPic
+    , _pjID = i
+    , _pjUpdate = updateTractor
+    , _pjTime = 10
+    }
+  where 
+    d  = unitVectorAtAngle dir
+
+{- |
+The interaction of this with objects, walls etc needs more thought.  -}
+updateTractor :: Prop -> World -> World
+updateTractor pj w
+    | _pjTime pj <= 0 = w & props %~ IM.delete i
+    | otherwise = w
+        & props . ix i . pjTime -~ 1
+        & creatures     %~ IM.map (tractCr   pullVel pos outpos)
+        & floorItems    %~ IM.map (tractFlIt pullVel pos outpos)
+  where 
+    i = _pjID pj
+    pullVel = _pjVel pj
+    pos = _pjPos pj
+    outpos = _pjStartPos pj
+
+tractFlIt :: Point2 -> Point2 -> Point2 -> FloorItem -> FloorItem
+tractFlIt q p1 outpos it 
+    | circOnSeg p1 outpos (_flItPos it) 10 = it & flItPos %~ tractorPullPos q p1
+    | otherwise = it
+
+tractCr :: Point2 -> Point2 -> Point2 -> Creature -> Creature
+tractCr q p1 outpos cr
+    | circOnSeg p1 outpos (_crPos cr) 10 = cr & crPos %~ tractorPullPos q p1
+    | otherwise = cr
+
+tractorPullPos :: Point2 -> Point2 -> Point2 -> Point2
+tractorPullPos q p1 p = p -.- m *.* (0.3/ x' *.* q +.+ g y *.* p4)
+  where
+    x' = abs y + 1
+    y = errorClosestPointOnLineParam 1 p1 p3 p
+    m | dist p p1 < 350 = 1
+      | otherwise        = (400 - dist p p1) / 50
+    g x | x > 5 = (10 - x) / 250
+        | x > 1 = 0.02
+        | x > -1 = x * 0.02
+        | x > -5 = -0.02
+        | otherwise = (x - 10) / 250
+    --p4 = vNormal p5
+    p4 = vNormal $ safeNormalizeV q
+    p3 = p1 +.+ p4
+
+tractorSPic :: Prop -> SPic
+tractorSPic pj = (,) mempty $ setLayer 1 $ setDepth 20 $ color (withAlpha 0.5 col) $ polygon 
+    [ spos  -- not sure if this is anticlockwise...
+    , spos +.+ size *.* (d +.+ n)
+    , xpos +.+ size *.* n
+    , xpos -.- size *.* n
+    , spos +.+ size *.* (d -.- n)
+    ]
+  where
+    size = fromIntegral (_pjTime pj)
+    spos = _pjPos pj
+    xpos = _pjStartPos pj
+    d = safeNormalizeV $ spos -.- xpos
+    n = vNormal d
+    col = mixColors 0.5 0.5 white blue

src/Dodge/Item/Weapon/Bezier.hs

@@ -1,12 +1,13 @@
 module Dodge.Item.Weapon.Bezier
-    where
+    ( bezierGun
+    ) where
 import Dodge.Data
 import Dodge.Base
 import Dodge.Default.Weapon
 import Dodge.Item.Data
 import Dodge.Item.Draw
 import Dodge.Item.Weapon.Targeting
-import Dodge.Item.Weapon.AutoGun
+import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Attachment.Data
@@ -16,10 +17,8 @@ import Dodge.Particle.Bullet.HitEffect
 import Dodge.WorldEvent.HitEffect
 import Dodge.RandomHelp
 import Dodge.SoundLogic.LoadSound
---import Picture
 import Geometry
 import ShapePicture
---import Shape
 
 import Data.Maybe
 import Control.Lens

src/Dodge/Item/Weapon/Booster.hs

@@ -1,15 +1,19 @@
 module Dodge.Item.Weapon.Booster
-    where
+    ( boosterGun
+    ) where
 import Dodge.Data
 import Dodge.Base
 import Dodge.Zone
 import Dodge.Base.Collide
+import Dodge.Default.Weapon
+import Dodge.Item.Data
 import Geometry
 import qualified IntMapHelp as IM
 import Dodge.Picture.Layer
 import Picture
 import Dodge.Item.Attachment.Data
 import ShapePicture
+import Shape
 
 import Data.Maybe
 import Control.Lens
@@ -113,6 +117,25 @@ drawBoostShockwave pj = (,) mempty $ setLayer 1 $ onLayer UPtLayer $ pictures $
 maxT :: Int
 maxT = 20
 
+boosterGun :: Item
+boosterGun = defaultGun 
+    { _itName = "BOOSTER"
+    , _itIdentity = Blinker
+    , _wpMaxAmmo = 100
+    , _wpLoadedAmmo = 100
+    , _wpReloadTime = 20
+    , _wpReloadState = 0
+    , _itUseRate = 0
+    , _itUseTime = 0
+    , _itUse = \_ -> boostSelf 10
+    , _itLeftClickUse = Just $ boostSelfL 10
+    , _wpSpread = 0.05
+    , _wpRange = 20
+    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
+    , _itAimingSpeed = 1
+    , _itAimingRange = 0
+    , _itEffect = resetAttachmentID
+    }
 resetAttachmentID :: ItEffect
 resetAttachmentID = ItInvEffect f 0
   where

src/Dodge/Item/Weapon/Bullet.hs

@@ -1,5 +1,8 @@
 module Dodge.Item.Weapon.Bullet
-  where
+    ( basicBullet
+    , ltBullet
+    , hvBullet
+    ) where
 import Dodge.Data
 import Dodge.WorldEvent.HitEffect
 import Dodge.Particle.Bullet.HitEffect

src/Dodge/Item/Weapon/BulletGuns.hs

@@ -0,0 +1,452 @@
+module Dodge.Item.Weapon.BulletGuns
+    ( pistol
+    , autoGun
+    , multGun
+    , miniGun
+    , spreadGun
+    , ltAutoGun
+    , hvAutoGun
+    , autogunSpread
+    , autoGunPic
+    , longGun
+    )
+    where
+import Dodge.Data
+import Dodge.Default.Weapon
+import Dodge.Default
+import Dodge.Item.Attachment
+import Dodge.Item.Attachment.Data
+import Dodge.Item.Weapon.ExtraEffect
+import Dodge.Item.Weapon.InventoryDisplay
+import Dodge.Item.Weapon.AmmoParams
+import Dodge.Item.Data
+import Dodge.Item.Draw
+import Dodge.Item.Weapon.Bullet
+import Dodge.Item.Weapon.TriggerType
+import Dodge.SoundLogic.LoadSound
+import Picture
+import Geometry
+import Geometry.Vector3D
+import ShapePicture
+import Shape
+
+import qualified Data.Sequence as Seq
+import Control.Lens
+
+autoGun :: Item
+autoGun = defaultAutoGun 
+    { _itName = "AUTOGUN"
+    , _itIdentity = AutoGun
+    , _wpMaxAmmo = 30
+    , _wpLoadedAmmo = 30
+    , _wpReloadTime = 80
+    , _wpReloadState = 0
+    , _itUseRate = 5
+    , _itUseTime = 0
+    , _itUse   = useAmmoParams
+    , _itUseModifiers =
+        [ ammoCheckI
+        , charFiringStratI
+            [('S', hammerCheckI)
+            ]
+        , useTimeCheckI
+        , charFiringStratI
+            [('M', torqueBefore 0.08) 
+            ,('S', torqueBefore 0.05) 
+            ]
+        , withSoundForI autoBS 5
+        , useAmmo 1
+        , withRandomDirI (autogunSpread/2)
+        , withMuzFlareI
+        , withSmoke 1 black 20 200 5
+        ]
+    , _wpSpread = autogunSpread
+    , _wpRange = 20
+    , _itFloorPict = autoGunPic
+    , _itAimingSpeed = 0.4
+    , _itAimingRange = 1
+    , _itZoom = defaultItZoom 
+    , _itAimZoom = defaultItZoom {_itZoomFac = 1.5}
+    , _itEquipPict = pictureWeaponOnAim autoGunPic
+    , _itAttachment = ItCharMode $ Seq.fromList "MS"
+    , _itScroll   = scrollCharMode
+    , _itInvDisplay = basicWeaponDisplay
+    , _wpAmmo = basicBullet    
+    }
+autoGunPic :: Item -> SPic
+autoGunPic it =
+    ( colorSH red (prismPoly 
+        (map (addZ 5) $ rectNESW 2 12 (-2) (-8))
+        (map (addZ 0) $ rectNESW 4 12 (-4) (-12))
+        )
+    <> translateSHf 0 (-1) (rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW (negate $ 3 + 0.25 * x) 0 3 (-5))
+    , mempty
+    )
+  where
+    x = fromIntegral $ loadedAmmo it
+
+
+pistol :: Item
+pistol = defaultGun 
+    { _itName = "PISTOL"
+    , _itIdentity = Pistol
+    , _wpMaxAmmo = 15
+    , _wpLoadedAmmo = 15
+    , _wpReloadTime = 40
+    , _wpReloadState = 0
+    , _itUseRate = 8
+    , _itUseTime = 0
+    , _itUse = useAmmoParams 
+    , _itUseModifiers = 
+        [ ammoCheckI
+        , hammerCheckI
+        , useTimeCheckI
+        , withSoundStart tap3S 
+        , useAmmo 1
+        , randSpreadDir
+        , withMuzFlareI
+        ]
+    , _itLeftClickUse = Nothing
+    , _wpSpread = 0.02
+    , _wpRange = 20
+    , _itFloorPict = pistolPic
+    , _itAimingSpeed = 1
+    , _itAimingRange = 0
+    , _itZoom = defaultItZoom
+    , _itEquipPict = pictureWeaponAim pistolPic
+    , _itID = Nothing
+    , _itInvDisplay = basicWeaponDisplay
+    , _itInvColor = white
+    , _itTargeting = Nothing
+    , _itWorldTrigger = Nothing
+    , _wpAmmo = basicBullet
+    }
+pistolPic :: Item -> SPic
+pistolPic it = 
+    ( colorSH green (prismPoly 
+        (map (addZ 3) $ rectNESW 3 3 (-3) (-3))
+        (map (addZ 0) $ rectNESW 5 3 (-5) (-7))
+    )
+    <> translateSH (V3 (-4) 5.5 4) (rotateSH pi $ bulletClip am)
+    , mempty
+    )
+  where
+    am = loadedAmmo it
+
+bulletClip :: Int -> Shape
+bulletClip x = rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW 3 0 (3 - 0.25 * am) (-5)
+  where
+    am = fromIntegral x
+
+hvAutoGun :: Item
+hvAutoGun = defaultAutoGun 
+    { _itName = "AUTO-HV"
+    , _itIdentity = HvAutoGun
+    , _wpMaxAmmo = 100
+    , _wpLoadedAmmo = 100
+    , _wpReloadTime = 200
+    , _wpReloadState = 0
+    , _itUseRate = 25
+    , _itUseTime = 0
+    , _itUse = useAmmoParams
+    , _itUseModifiers =
+        [ ammoCheckI
+        , rateIncABI 24 7 (torqueBeforeAtLeast 0.1 0.1) (torqueAfterI 0.2)
+        , withSoundStart bangEchoS
+        , withThinSmokeI
+        , withMuzFlareI
+        ]
+    , _wpRange = 20
+    , _itFloorPict = hvAutoGunPic
+    , _itAimingSpeed = 0.2
+    , _itAimingRange = 1
+    , _itEquipPict = pictureWeaponOnAim hvAutoGunPic
+    , _wpAmmo = hvBullet
+    }
+hvAutoGunPic :: Item -> SPic
+hvAutoGunPic it = 
+    ( colorSH orange (prismPoly
+        (map (addZ 5) $ rectNESW 3 12 (-3) (-8))
+        (map (addZ 0) $ rectNESW 5 12 (-5) (-12))
+        )
+    <> bulletClip am
+    , mempty
+    )
+  where
+    am = loadedAmmo it
+ltAutoGun :: Item                           
+ltAutoGun = defaultAutoGun 
+    { _itName = "AUTO-LT"
+    , _itIdentity = LtAutoGun
+    , _wpMaxAmmo = 25
+    , _wpLoadedAmmo = 25
+    , _wpReloadTime = 80
+    , _wpReloadState = 0
+    , _itUseRate = 3
+    , _itUseTime = 0
+    , _itUse = useAmmoParams
+    , _itUseModifiers = 
+        [ ammoCheckI
+        , useTimeCheckI
+        , withSoundStart tap1S
+        , useAmmo 1
+        , withRandomDirI 0.1
+        , torqueAfterI 0.2
+        , withSidePushI 50
+        , modClock 2 withMuzFlareI
+        ]
+    , _wpSpread = 0.5
+    , _wpRange = 20
+    , _itFloorPict = ltAutoGunPic
+    , _itAimingSpeed = 1
+    , _itAimingRange = 0
+    , _itZoom = defaultItZoom
+    , _itEquipPict = pictureWeaponOnAim ltAutoGunPic    
+    , _itAimStance = OneHand
+    , _wpAmmo = ltBullet
+    }
+    & itDimension . muzzleLength .~ 10 
+ltAutoGunPic :: Item -> SPic
+ltAutoGunPic it = 
+    ( colorSH green $ prismPoly 
+        (map (addZ 5) $ mirrorXAxis [V2 (-2) 3, V2 5 3, V2 10 0])
+        (map (addZ 0) $ mirrorXAxis [V2 (-5) 5, V2 5 5, V2 10 0])
+        <> bulletClip am
+    , mempty
+    )
+  where
+    am = loadedAmmo it
+miniGun :: Item
+miniGun = defaultAutoGun 
+    { _itName = "MINI-G"
+    , _itIdentity = MiniGun
+    , _wpMaxAmmo = 1500
+    , _wpLoadedAmmo = 1500
+    , _wpReloadTime = 200
+    , _wpReloadState = 0
+    , _wpMaxWarmUp = 100
+    , _itUseRate = 0
+    , _itUseTime = 0
+    , _itUse = useAmmoParamsVelMod vm4
+    , _itUseModifiers =
+        [ ammoCheckI
+        , withWarmUpI crankSlowS
+        , useTimeCheckI
+        --, afterRecoil recoilAmount
+        , withSoundForI mini1S 2
+        --, withThinSmokeI
+        , torqueAfterI 0.05
+        , withSidePushI 53
+        , afterRecoil recoilAmount
+        , withRandomOffsetI 12
+        , trigDoAlso (useAmmoParamsVelMod vm1)
+        --, torqueBeforeForcedI 0.001
+        , withSidePushI 52
+        , afterRecoil recoilAmount
+        , withRandomOffsetI 11
+        , withOldDir od1
+        , trigDoAlso (useAmmoParamsVelMod vm2)
+        --, torqueBeforeForcedI 0.001
+        , withSidePushI 51
+        , afterRecoil recoilAmount
+        , withRandomOffsetI 10
+        , withOldDir od2
+        , trigDoAlso (useAmmoParamsVelMod vm3)
+        , useAmmo 4
+        --, torqueBeforeForcedI 0.001
+        , withSidePushI 50
+        , afterRecoil recoilAmount
+        , withRandomOffsetI 9
+        , withMuzFlareI
+        , withOldDir od3
+        , withSmoke 1 black 20 200 5
+        ]
+    , _wpRange = 20
+    , _itFloorPict = miniGunPictItem
+    , _itAimingSpeed = 0.4
+    , _itAimingRange = 1
+    , _itEquipPict = pictureWeaponAim miniGunPictItem
+    , _wpAmmo = basicBullet
+    }
+  where
+    recoilAmount = 5
+    [vm1,vm2,vm3,vm4] = 
+        [ 0.25
+        , 0.5
+        , 0.75
+        , 1
+        ]
+    [od1,od2,od3] = 
+        [ 0.25, 0.5, 0.9]
+        --[ 0.75, 0.5, 0.25]
+        --[ 0, 0, 0]
+miniGunPictItem :: Item -> SPic
+miniGunPictItem it = miniGunPict spin (loadedAmmo it)
+  where
+    spin = (-10) * _wpLoadedAmmo it + _wpCurWarmUp it
+
+miniGunPict :: Int -> Int -> SPic
+miniGunPict spin am = 
+    (   colorSH red (rotateSHx a barrels)
+        <> colorSH red (upperPrismPoly 5 $ rectNESW 8 8 (-8) 4)
+        <> colorSH red (prismPoly 
+                (map (addZ 5) $ rectNESW 2 12 (-2) (-12))
+                (map (addZ 0) $ rectNESW 4 12 (-4) (-16))
+            )
+        <> clip (-1) 0
+        <> clip (-7) 0
+    , mempty
+    )
+  where
+    aBarrel = translateSH (V3 7 0 9) $ prismPoly
+        (map (addZ 5) $ rectNESW 2 12 (-2) (-1))
+        (map (addZ 0) $ rectNESW 4 12 (-4) (-5))
+    barrels = concatMap (\an -> aBarrel & rotateSHx an) [0,0.5* pi, pi, 1.5*pi]
+    a = fromIntegral spin / 100
+    x = fromIntegral am / 10
+    clip y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4) 
+        . upperPrismPoly 2 
+        $ rectNESW (negate $ 3 + 0.25 * x) y 3 (y-5))
+spreadGun :: Item
+spreadGun = defaultGun 
+    { _itName = "SPREAD"
+    , _itIdentity = SpreadGun
+    , _wpMaxAmmo = 5
+    , _wpLoadedAmmo = 5
+    , _wpReloadTime = 80
+    , _wpReloadState = 0
+    , _itUseRate = 20
+    , _itUseTime = 0
+    --, _itUse = \_ -> spreadNumVelWthHiteff spreadGunSpread 9 (V2 30 0) 2 basicBulletEffect
+    , _itUse = useAmmoParams
+    , _itUseModifiers =
+        [ ammoCheckI
+        , hammerCheckI
+        , useTimeCheckI
+        , withSoundStart shotgunS
+        , useAmmo 1
+        , withRecoilI 100
+        , withMuzFlareI
+        , spreadNumI
+        ]
+    , _wpSpread = spreadGunSpread
+    , _wpRange = 20
+    , _itFloorPict = spreadGunPic
+    , _itAimingSpeed = 1
+    , _itAimingRange = 0
+    , _itEquipPict = pictureWeaponOnAim spreadGunPic
+    , _wpAmmo = basicBullet
+    , _wpNumBarrels = 50
+    }
+spreadGunPic :: Item -> SPic
+spreadGunPic it = 
+    ( colorSH green (upperPrismPoly 5 $ map toV2[(-3,0),(3,6),(3,-6)])
+    <> bulletClip am
+    , mempty
+    )
+  where
+    am = loadedAmmo it
+multGun :: Item
+multGun = defaultGun 
+    { _itName = "MULTGUN"
+    , _itIdentity = MultGun
+    , _wpMaxAmmo = 2
+    , _wpLoadedAmmo = 2
+    , _wpReloadTime = 40
+    , _wpReloadState = 0
+    , _itUseRate = 20
+    , _itUseTime = 0
+    , _itUse = useAmmoParams
+    , _itUseModifiers =
+        [ ammoCheckI
+        , hammerCheckI
+        , useTimeCheckI
+        , withSoundStart shotgunS
+        , useAmmo 1
+        , withRecoilI 200
+        , withMuzFlareI
+        , numI
+        ]
+    , _wpSpread = spreadGunSpread
+    , _wpRange = 20
+    , _itFloorPict = multGunSPic
+    , _itAimingSpeed = 0.4
+    , _itAimingRange = 1
+    , _itZoom       = defaultItZoom
+    , _itAimZoom    = defaultItZoom {_itZoomFac = 1.5}
+    , _itEquipPict = pictureWeaponOnAim multGunSPic
+    , _itAimStance = TwoHandTwist
+    , _wpAmmo = basicBullet
+    , _wpNumBarrels = 5
+    }
+multGunSPic :: Item -> SPic
+multGunSPic it = 
+    ( colorSH red (
+        upperPrismPoly 2 (rectNESW 4 8 (-4) (-12)) <>
+        translateSHf 8 0 (concatMap barrel [12,7,2,-3,-8] <> 
+            upperPrismPoly 2 (map toV2 [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)])
+            )
+    ) <> bulletClip am
+    , mempty
+    )
+  where
+    barrel y = prismPoly 
+        (map (addZ 5) $ rectNSEW y (y-4) 2   0 )
+        (map (addZ 0) $ rectNSEW y (y-4) 2 (-2))
+    am = loadedAmmo it
+longGun :: Item
+longGun = defaultGun 
+    { _itName = "LONGGUN"
+    , _itIdentity = LongGun
+    , _wpMaxAmmo = 1
+    , _wpLoadedAmmo = 1
+    , _wpReloadTime = 100
+    , _wpReloadState = 0
+    , _wpReloadType = PassiveReload skwareFadeTwoSecS
+    , _itUseRate = 100
+    , _itUseTime = 0
+    , _itUse = useAmmoParams
+    , _itUseModifiers =
+        [ ammoCheckI
+        , hammerCheckI
+        , useTimeCheckI
+        , withSoundStart bangEchoS
+        , useAmmo 1
+        , withThickSmokeI
+        , torqueAfterI 0.05
+        , withMuzFlareI
+        ]
+    , _wpRange = 200
+    , _itFloorPict = longGunSPic
+    , _itAimingSpeed = 0.2
+    , _itAimingRange = 1
+    , _itZoom       = defaultItZoom 
+    , _itAimZoom    = defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}
+    , _itEquipPict = pictureWeaponOnAim longGunSPic
+    , _itScroll = zoomLongGun
+    , _itAttachment = ItScope (V2 0 0) 0 1 False
+    , _itEffect = itemLaserScopeEffect
+    , _wpAmmo = hvBullet
+    , _itAimStance = TwoHandTwist
+    }
+longGunSPic :: Item -> SPic
+longGunSPic _ =
+    ( colorSH orange $ upperPrismPoly 5 $ rectWH 12 2
+    , mempty
+    )
+
+zoomLongGun :: Float -> Creature -> Item -> Item
+zoomLongGun x _
+    | x > 0 = startZoomInLongGun 
+    | x < 0 = startZoomOutLongGun
+    | otherwise = id
+
+startZoomInLongGun :: Item -> Item
+startZoomInLongGun   = itAttachment . scopeZoomChange %~ \x -> max 5 (x + 5)
+startZoomOutLongGun :: Item -> Item
+startZoomOutLongGun  = itAttachment . scopeZoomChange %~ \x -> min (-5) (x-5)
+
+spreadGunSpread :: Float
+spreadGunSpread = 0.5
+autogunSpread :: Float
+autogunSpread = 0.07

src/Dodge/Item/Weapon/Decoration.hs

@@ -2,7 +2,8 @@
 Particles and pictures that decorate weapons, such as laser scopes etc.
 -}
 module Dodge.Item.Weapon.Decoration
-    where
+    ( makeLaserScope
+    ) where
 import Dodge.Data
 import Dodge.Picture.Layer
 import Dodge.Picture
@@ -26,4 +27,3 @@ makeLaserScope p ep relFrac = Particle
   where
     lineAlphaThick a w = 
         color (withAlpha a $ mixColors relFrac (1-relFrac) red green) $ lineOfThickness w [p,ep]
-

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -3,13 +3,18 @@
 Extra weapon effects, supplementing explicit use effects.
  -}
 module Dodge.Item.Weapon.ExtraEffect
-    where
+    ( wpRecock
+    , itemLaserScopeEffect
+    , autoSonarEffect
+    , autoRadarEffect
+    , rbSetTarget
+    ) where
 import Dodge.Data
 import Dodge.Base
 import Dodge.Item.Data
 import Dodge.Item.Weapon.Decoration
 import Dodge.Item.Weapon.UseEffect
-import Dodge.Item.Attachment.Data
+--import Dodge.Item.Attachment.Data
 import Dodge.WorldEvent.ThingsHit
 import Dodge.Picture.Layer
 import Dodge.Creature.Test
@@ -36,19 +41,19 @@ wpRecock = ItInvEffect
     moveHammerUp HammerUp       = HammerUp
     moveHammerUp NoHammer       = NoHammer
     fOnIt it = it & itHammer %~ moveHammerUp
-{- |
+--{- |
-Special recock for the bezier gun.
+--Special recock for the bezier gun.
-Not sure of its purpose at this time...  -}
+--Not sure of its purpose at this time...  -}
-bezierRecock :: ItEffect
+--bezierRecock :: ItEffect
-bezierRecock = ItInvEffect 
+--bezierRecock = ItInvEffect 
-    {_itInvEffect = f
+--    {_itInvEffect = f
-    ,_itEffectCounter = 0
+--    ,_itEffectCounter = 0
-    }
+--    }
-  where 
+--  where 
-    f _ cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
+--    f _ cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
-    fOnIt it = case _itHammer it of
+--    fOnIt it = case _itHammer it of
-                  HammerDown -> it & itHammer .~ HammerUp
+--                  HammerDown -> it & itHammer .~ HammerUp
-                  _          -> it & itAttachment .~ NoItAttachment
+--                  _          -> it & itAttachment .~ NoItAttachment
 {- |
 Creates a laser scope and recocks the weapon.
 TODO add the laser scope!

src/Dodge/Item/Weapon/Grenade.hs

@@ -1,14 +1,22 @@
 module Dodge.Item.Weapon.Grenade
-    where
+    ( grenade
+    ) where
 import Dodge.Data
 import Dodge.Data.SoundOrigin
 import Dodge.Item.Data
+import Dodge.Picture.Layer
+import Dodge.WorldEvent.Explosion
+import Dodge.Item.Weapon.TriggerType
+import Dodge.Default
 import Dodge.Base
 import Dodge.Zone
 import Dodge.SoundLogic
 import Dodge.SoundLogic.LoadSound
 import Dodge.Item.Attachment.Data
 import Dodge.Item.Draw
+import Dodge.Item.Weapon.InventoryDisplay
+import Dodge.Item.Weapon.ExtraEffect
+import Dodge.Item.Attachment
 import Picture
 import Geometry
 import ShapePicture
@@ -17,6 +25,39 @@ import Shape
 import Control.Lens
 import qualified Data.IntMap.Strict as IM
 
+grenade :: Item
+grenade = Throwable
+    { _itName = "GRENADE " ++ show fuseTime
+    , _itIdentity = Grenade
+    , _itMaxStack = 8
+    , _itAmount = 1
+    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
+    , _twMaxRange = 150
+    , _twAccuracy = 30
+    , _itUse = \_ -> throwGrenade makeExplosionAt
+    , _itUseModifiers =
+        [ useTimeCheckI
+        ]
+    , _itAimingSpeed = 1
+    , _itAimingRange = 0
+    , _itZoom       = defaultItZoom
+    , _itAimZoom    = defaultItZoom {_itZoomMax = f fuseTime, _itZoomMin = f fuseTime}
+    , _itEquipPict = pictureWeaponOnAim $ \_ -> grenadePic fuseTime
+    , _itID = Nothing
+    , _itUseRate = 25 
+    , _itUseTime = 0
+    , _itAttachment = ItFuse fuseTime
+    , _itInvColor = white
+    , _itInvDisplay = basicWeaponDisplay
+    , _itEffect = wpRecock
+    , _itHammer = HammerUp
+    , _itScroll = changeFuse
+    , _itAimStance = OneHand
+    }
+  where 
+    fuseTime = 50
+    f x = 50 / fromIntegral x
+
 moveGrenade :: Prop -> World -> World
 moveGrenade pj w
     | _pjTimer pj <= 0 = w 
@@ -43,8 +84,6 @@ grenadePic time =
         [ color green $ arc (degToRad $ (179 * fromIntegral time / 50) - 180 ) 
                             (degToRad $ 180 - (179 * fromIntegral time / 50) ) 
                             5
---        , translate (-2) 2 $ rotate (pi*0.5) 
---            $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot time 20 
         ]
     )
 
@@ -77,8 +116,6 @@ throwGrenade thePayload cr w = setWp $ removePict $ over props addG w
     j = _crInvSel cr
     removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> (,) emptySH blank
     i = newProjectileKey w
-    --(_, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w)
-    --(_, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g
     v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w)
     v | magV v' > 6 = 6 *.* normalizeV v'
       | otherwise   = v'
@@ -99,3 +136,19 @@ throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x }
             & itHammer .~ HammerUp 
             & itEquipPict .~ pictureWeaponOnAim (\_ -> grenadePic 50)
         | otherwise = it & itEffect . itEffectCounter -~ 1
+
+--flameGrenade :: Item
+--flameGrenade = grenade {
+--     _itName = "FLMGREN " ++ show fuseTime
+--     , _itUse = \_ -> throwGrenade makeFlameExplosionAt
+--    }
+--  where 
+--    fuseTime = 50 :: Int
+--
+--teslaGrenade :: Item
+--teslaGrenade = grenade {
+--     _itName = "TLSGREN " ++ show fuseTime
+--     , _itUse = \_ -> throwGrenade makeTeslaExplosionAt
+--    }
+--  where 
+--    fuseTime = 50 :: Int

src/Dodge/Item/Weapon/InventoryDisplay.hs

@@ -2,15 +2,14 @@
 Display of weapon strings in the inventory.
  -}
 module Dodge.Item.Weapon.InventoryDisplay
-    where
+    ( basicWeaponDisplay
+    ) where
 import Dodge.Data
---import Dodge.Base
 import Dodge.Item.Attachment.Data
 import Padding
 
 import Data.Sequence
 import Control.Lens
---import Control.Monad
 {- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.  -}
 basicWeaponDisplay :: Item -> String
 basicWeaponDisplay it = case it ^? itAttachment of
@@ -18,7 +17,6 @@ basicWeaponDisplay it = case it ^? itAttachment of
     Just ItMode {_itMode = i} -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ++ show i
     _   -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded)
   where 
-    --availableAmmo = show $ _wpMaxAmmo it
     aIfLoaded = case it ^? wpReloadState of 
         Just 0 -> show $ _wpLoadedAmmo it
         Just x -> "R" ++ show x

src/Dodge/Item/Weapon/Laser.hs

@@ -1,122 +0,0 @@
-{- | Laser effects -}
-module Dodge.Item.Weapon.Laser
-    where
-import Dodge.Data
-import Dodge.Data.DamageType
-import Dodge.Picture
---import Dodge.Picture.Layer
-import Dodge.Item.Attachment.Data
---import Dodge.Base
---import Dodge.SoundLogic
-import Dodge.WorldEvent.SpawnParticle
-import Dodge.WorldEvent.ThingsHit
-import Dodge.WorldEvent.HelperParticle
---import Dodge.WorldEvent.Flash
-import Dodge.Creature.State.Data
-import Geometry
-import Picture
-
-import Control.Lens
-import System.Random
-import Data.Tuple
-import Data.List (find)
-import Data.Maybe (fromMaybe)
-import qualified Data.Sequence as Seq
---import qualified Data.IntMap.Strict as IM
-
-aLaser :: Creature -> World -> World
-aLaser cr = particles %~ (makeLaserAt phaseV pos dir : )
-  where 
-    pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) 
-    dir = _crDir cr
-    phaseV = charToPhaseV 
-        $ fromMaybe '/' $ Seq.lookup 0 =<< cr ^? crInv . ix j . itAttachment . itCharMode
-    j = _crInvSel cr
-
-charToPhaseV :: Fractional p => Char -> p
-charToPhaseV 'V'    = 0.2
-charToPhaseV '/'   = 1
-charToPhaseV 'Z'    = 5
-charToPhaseV _ = error "Trying to set an undefined phaseV"
-
-makeLaserAt :: Float -> Point2 -> Float -> Particle
-makeLaserAt phaseV pos dir = Particle
-    { _ptDraw = const blank
-    , _ptUpdate = moveLaser phaseV pos dir
-    }
-
-moveLaser 
-    :: Float    -- ^ Phase velocity, controls deflection through windows
-    -> Point2 
-    -> Float 
-    -> World 
-    -> Particle 
-    -> (World, Maybe Particle)
-moveLaser phaseV pos dir w pt
-    = ( set randGen g $ hitEffect w
-      , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
-      )
-  where 
-    xp = pos +.+ 800 *.* unitVectorAtAngle dir
-    (a,g)  = randomR (-0.7,0.7) $ _randGen w
-    reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (xp -.- pos))
-    f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either Creature Wall),[Point2])
-    f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of
-        Just (p,Right wl) 
-            | _wlIsSeeThrough wl -> f' p $ f (wl:seenWs) p (h x y wl p)
-            | otherwise -> (Just (p,Right wl), [p])
-        Just (p,obj) -> (Just (p,obj), [p])
-        Nothing -> (Nothing, [y])
-    f' p (x,ps') = (x,p:ps')
-    h x y wl p 
-        | isEntering = p +.+ rotateV angleRef normalDist
-        | otherwise = p +.+ rotateV angleRef' normalDist'
-      where 
-        wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl)
-        normalDist = magV (p -.- y) *.* normalizeV wlNormal
-        angleInc = piRange $ argV wlNormal - argV (x -.- y)
-        angleRef 
-            | reflectExternal = angleInc
-            | otherwise = asin $ sin angleInc / phaseV
-        piRange a' 
-            | a' > pi = a' - 2 * pi
-            | a' > negate pi = a'
-            | otherwise  = a' + 2 * pi
-        isEntering = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl))
-        wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl)
-        normalDist' = magV (p -.- y) *.* normalizeV wlNormal'
-        angleInc' = piRange $ argV wlNormal' - argV (x -.- y)
-        angleRef' 
-            | reflectInternal = angleInc'
-            | otherwise = asin $ phaseV * sin angleInc'
-        reflectInternal = 1 < abs (phaseV * sin angleInc')
-        reflectExternal = 1 < abs (sin angleInc / phaseV)
-            
-    h' ws (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws
-    h' _ _ = True
-    (thHit, ps) = f [] pos xp
-    hitEffect
-      = case thHit of
-          Just (p,Left cr) 
-              -> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 19 pos p xp)
-          Just (p,Right wl) -> createSparkCol 8 (V4 20 (-5) 0 1) (p +.+ safeNormalizeV (pos -.- p))
-                                                      (reflectDir wl)
-          _   -> id
-    pic = setLayer 1 $ pictures
-        [ setDepth 19   . color (brightX 0 0.5 yellow) $ lineOfThickness 20 (pos:ps)
-        , setDepth 19.5 . color (brightX 10 1 yellow)  $ lineOfThickness 3  (pos:ps)
-        ]
-
-fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture
-fadeLine sp ep alph width col = setLayer 1 $ polygonCol 
-    [(sp       , ca)
-    ,(sp +.+ n , cb)
-    ,(ep +.+ n , cb)
-    ,(ep       , ca)
-    ,(ep -.- n , cb)
-    ,(sp -.- n , cb)
-    ]
-  where 
-    n = width *.* normalizeV (vNormal $ ep -.- sp)
-    ca = withAlpha alph col
-    cb = withAlpha 0 col

src/Dodge/Item/Weapon/Launcher.hs

@@ -1,5 +1,7 @@
 module Dodge.Item.Weapon.Launcher
-    where
+    ( launcher
+    , remoteLauncher
+    ) where
 import Dodge.Data
 import Dodge.Data.SoundOrigin
 import Dodge.Default.Weapon
@@ -132,12 +134,12 @@ doThrust pj w = w
     r1 = randInCirc 10 & evalState $ _randGen w
     smokeGen = shellTrailCloud $ addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
 
-flameLauncher :: Item
+--flameLauncher :: Item
-flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt
+--flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt
-poisonLauncher :: Item
+--poisonLauncher :: Item
-poisonLauncher = launcher & wpAmmo . amPayload .~ makePoisonExplosionAt
+--poisonLauncher = launcher & wpAmmo . amPayload .~ makePoisonExplosionAt
-teslaLauncher :: Item
+--teslaLauncher :: Item
-teslaLauncher = launcher & wpAmmo . amPayload .~ makeTeslaExplosionAt
+--teslaLauncher = launcher & wpAmmo . amPayload .~ makeTeslaExplosionAt
 
 aRocketWithItemParams
     :: Item   -- ^ Firing item

src/Dodge/Item/Weapon/Remote.hs

@@ -1,5 +1,6 @@
 module Dodge.Item.Weapon.Remote
-    where
+    ( pointToItem
+    ) where
 import Dodge.Data
 
 import Control.Lens

src/Dodge/Item/Weapon/Shell.hs

@@ -1,4 +1,6 @@
 module Dodge.Item.Weapon.Shell
+    ( decTimMvVel
+    )
     where
 import Dodge.Data
 import Geometry.Vector

src/Dodge/Item/Weapon/SprayGuns.hs

@@ -0,0 +1,119 @@
+module Dodge.Item.Weapon.SprayGuns
+    ( poisonSprayer
+    , flamer
+    )
+    where
+import Dodge.Data
+--import Dodge.Data.SoundOrigin
+--import Dodge.Base
+--import Dodge.Zone
+--import Dodge.Picture.Layer
+--import Dodge.SoundLogic
+import Dodge.SoundLogic.LoadSound
+--import Dodge.Creature.Action
+import Dodge.WorldEvent
+import Dodge.Default
+import Dodge.Item.Draw
+import Dodge.Item.Data
+--import Dodge.Item.Weapon.BulletGuns
+--import Dodge.Item.Weapon.InventoryDisplay
+import Dodge.Item.Weapon.TriggerType
+--import Dodge.Item.Weapon.ExtraEffect
+--import Dodge.Item.Weapon.UseEffect
+import Dodge.Item.Weapon.AmmoParams
+import Dodge.Item.Attachment.Data
+import Dodge.Default.Weapon
+--import Dodge.Item.Attachment
+import Geometry
+--import Geometry.Vector3D
+import Picture
+import Shape
+import ShapePicture
+
+import Data.Function
+import Control.Lens
+import System.Random
+poisonSprayer :: Item
+poisonSprayer = defaultAutoGun 
+    { _itName = "POISON"
+    , _itIdentity = PoisonSprayer
+    , _wpMaxAmmo = 500
+    , _wpLoadedAmmo = 500
+    , _wpReloadTime = 100
+    , _wpReloadState = 0
+    , _itUseRate = 0
+    , _itUseTime = 0
+    , _itUse = const aGasCloud 
+    , _itUseModifiers =
+        [ ammoCheckI
+        , useTimeCheckI
+        , withSoundForI foamSprayLoopS 5
+        , useAmmo 1
+        , spreadNumI
+        ]
+    , _wpRange = 8
+    , _itFloorPict = flamerPic
+    , _itAimingSpeed = 0.2
+    , _itAimingRange = 0
+    , _itZoom = defaultItZoom
+    , _itEquipPict = pictureWeaponOnAim flamerPic
+    , _wpSpread = 0.1
+    , _wpNumBarrels = 3
+    }
+flamer :: Item
+flamer = defaultAutoGun 
+    { _itName = "FLAMER"
+    , _itIdentity = Flamethrower
+    , _wpMaxAmmo = 250
+    , _wpLoadedAmmo = 250
+    , _wpReloadTime = 100
+    , _wpReloadState = 0
+    , _itUseRate = 0
+    , _itUseTime = 0
+    , _itUse = \_ -> randWalkAngle 0.2 0.01 aFlame
+    , _itUseModifiers =
+        [ ammoUseCheckI
+        , withSidePushI 5
+        --, withTempLight 1 100 (V3 1 0 0)
+        , withSidePushAfterI 20
+        ]
+    , _wpSpread = 0
+    , _wpRange = 8
+    , _itFloorPict = flamerPic
+    , _itAimingSpeed = 0.5
+    , _itAimingRange = 0
+    , _itZoom       = defaultItZoom
+    , _itAimZoom    = defaultItZoom {_itZoomMax = 5, _itZoomMin = 1.5}
+    , _itEquipPict = pictureWeaponOnAim flamerPic
+    , _itAttachment = NoItAttachment
+    }
+flamerPic :: Item -> SPic
+flamerPic it = 
+    ( colorSH yellow $ 
+        translateSHf tx ty (upperPrismPoly tz $ polyCirc 3 r)
+        ++ upperPrismPoly 5 (rectNESW 2 9 (-2) (-9))
+    , color black $ translate3 (V3 tx ty (tz+0.01)) $ circleSolid (r * am)
+    )
+  where
+    tx = - 5
+    ty = - 6
+    tz = 3
+    r = 5
+    am = fractionLoadedAmmo2 it
+aGasCloud :: Creature -> World -> World
+aGasCloud cr w = insertCloud $ set randGen g w
+  where 
+    (a,g) = randomR (-0.1,0.1) (_randGen w)
+    dir = _crDir cr + a
+    pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
+    vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir
+    insertCloud = makeGasCloud pos vel
+
+aFlame :: Creature -> World -> World
+aFlame cr w = w & particles %~ (aFlameParticle t pos vel (Just cid) :)
+  where 
+    (t,_) = randomR (99,101) (_randGen w)
+    cid = _crID cr
+    dir = _crDir cr
+    pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
+    vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir

src/Dodge/Item/Weapon/TriggerType.hs

@@ -6,7 +6,6 @@ module Dodge.Item.Weapon.TriggerType
     , withOldDir
     , trigDoAlso
     , withTempLight
-    --, withVelWthHiteff
     , ammoUseCheckI
     , rateIncABI
     , torqueBefore
@@ -42,8 +41,6 @@ import Dodge.Data.SoundOrigin
 import Dodge.SoundLogic
 import Dodge.Creature.Action (startReloadingWeapon)
 import Dodge.WorldEvent
---import Dodge.WorldEvent.Flash
---import Dodge.WorldEvent.Cloud
 import Dodge.RandomHelp
 import Dodge.Item.Attachment.Data
 import Dodge.Item.Data
@@ -51,7 +48,6 @@ import Dodge.Default
 import Sound.Data
 import Geometry
 import Geometry.Vector3D
---import Color
 
 import System.Random
 import Control.Lens
@@ -60,8 +56,8 @@ import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import Data.Foldable
 
-type ChainEffect = 
+type ChainEffect 
-    (Item -> Creature -> World -> World)
+     = (Item -> Creature -> World -> World)
     -> Item
     -> Creature
     -> World 
@@ -74,8 +70,7 @@ trigDoAlso
 trigDoAlso afterEff eff item cr = afterEff item cr . eff item cr
 
 withSmoke :: Int -> Point4 -> Float -> Int -> Float -> ChainEffect
-withSmoke num col rad t alt eff item cr w 
+withSmoke num col rad t alt eff item cr w = eff item cr 
-    = eff item cr 
     $ foldl' (flip $ smokeCloudAt col rad t alt . (+.+.+ pos) . (*8)) w ps
   where
     dir = _crDir cr
@@ -83,14 +78,16 @@ withSmoke num col rad t alt eff item cr w
     ps = replicateM num randOnUnitSphere & evalState $ _randGen w
 
 withThinSmokeI :: ChainEffect
-withThinSmokeI eff item cr w = eff item cr $ foldl' (flip $ makeThinSmokeAt . (+.+.+ pos) . (* 8)) w ps
+withThinSmokeI eff item cr w = eff item cr 
+    $ foldl' (flip $ makeThinSmokeAt . (+.+.+ pos) . (* 8)) w ps
   where
     dir = _crDir cr
     pos = addZ 0 $ _crPos cr +.+ (_crRad cr +0.5) *.* unitVectorAtAngle dir
     ps = replicateM 5 randOnUnitSphere & evalState $ _randGen w
 
 withThickSmokeI :: ChainEffect
-withThickSmokeI eff item cr w = eff item cr $ foldl' (flip $ makeThickSmokeAt . (+.+.+ pos) . (*8)) w ps
+withThickSmokeI eff item cr w = eff item cr 
+    $ foldl' (flip $ makeThickSmokeAt . (+.+.+ pos) . (*8)) w ps
   where
     dir = _crDir cr
     pos = addZ 0 $ _crPos cr +.+ (_crRad cr + 15) *.* unitVectorAtAngle dir
@@ -130,10 +127,8 @@ rateIncABI startRate fastRate exeffFirst exeffCont eff item cr w
     itRef = _crInvSel cr
     pointItem = creatures . ix cid . crInv . ix itRef
     currentRate = _itUseRate item
-    repeatFire = _wpReloadState item == 0 
+    repeatFire = _wpReloadState item == 0 && _itUseTime item == 1 
-        && _itUseTime item == 1 
+    firstFire  = _wpReloadState item == 0 && _itUseTime item == 0 
-    firstFire = _wpReloadState item == 0 
-        && _itUseTime item == 0 
 {- | Apply effect after a warm up.  -}
 withWarmUpI
     :: SoundID -- ^ warm up sound id
@@ -159,7 +154,6 @@ withSoundStart
     -> ChainEffect
 withSoundStart soundid f item cr 
     = soundMultiFrom [CrWeaponSound cid 0,CrWeaponSound cid 1,CrWeaponSound cid 2] (_crPos cr) soundid Nothing
---    = soundStart (CrWeaponSound cid 0) (_crPos cr) soundid Nothing
     . f item cr
   where
     cid = _crID cr
@@ -173,7 +167,6 @@ withSoundContinue soundid f item cr
     . f item cr
   where
     cid = _crID cr
-
 {- | Adds a sound to a creature based world effect. 
 The sound is emitted from the creature's position. -}
 withSoundForI
@@ -203,9 +196,9 @@ Applied before the underlying effect.  -}
 withSidePushI
     :: Float    -- ^ Maximal possible side push amount
     -> ChainEffect
-withSidePushI maxSide eff item cr w = eff item (push cr) $
+withSidePushI maxSide eff item cr w = eff item (push cr) $ w 
-    w & creatures . ix cid %~ push
+    & creatures . ix cid %~ push
-      & randGen .~ g
+    & randGen .~ g
   where 
     cid = _crID cr
     push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr)))
@@ -216,8 +209,8 @@ Applied after the underlying effect.  -}
 withSidePushAfterI
     :: Float    -- ^ Maximal possible side push amount
     -> ChainEffect
-withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff item cr $ 
+withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff item cr $ w 
-    w & randGen .~ g
+    & randGen .~ g
   where 
     cid = _crID cr
     push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr)))
@@ -225,8 +218,8 @@ withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff
 useAmmo
     :: Int  -- ^ amount of ammo to use
     -> ChainEffect
-useAmmo amAmount eff item cr = eff item cr .
+useAmmo amAmount eff item cr = eff item cr
-    (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . wpLoadedAmmo -~ amAmount)
+    . (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . wpLoadedAmmo -~ amAmount)
 {- | 
 Applies a world effect after an item use cooldown check. -}
 useTimeCheckI :: ChainEffect
@@ -314,8 +307,7 @@ modClock n chainEff eff it cr w
     | otherwise = eff it cr w
 
 withMuzFlareI :: ChainEffect
-withMuzFlareI f it cr w = 
+withMuzFlareI f it cr w = makeTLight 3 100 (V3 1 1 0.5) flashPos
-    makeTLight 3 100 (V3 1 1 0.5) flashPos
     . muzFlareAt (V4 5 5 0 2) flarePos dir
     $ f it cr w
   where 
@@ -324,7 +316,6 @@ withMuzFlareI f it cr w =
     flashPos = addZ 35 $ _crPos cr +.+ (2.5 * _crRad cr) *.* unitVectorAtAngle dir
     dir = _crDir cr
     itLength = _muzzleLength $ _itDimension it
-
 {- | Applies the effect to a randomly rotated creature,
  - rotation amount given by wpSpread  -}
 randSpreadDir :: ChainEffect
@@ -332,7 +323,6 @@ randSpreadDir f it cr w = f it (cr & crDir +~ a) $ set randGen g w
   where 
     acc = _wpSpread it
     (a, g) = randomR (-acc,acc) $ _randGen w
-
 {- | Applies the effect to a randomly rotated creature.  -}
 withRandomDirI
     :: Float    -- ^ Max possible rotation

src/Dodge/Item/Weapon/UseEffect.hs

@@ -4,15 +4,9 @@ These are typically item effects, and typical occur when an item is explictly us
 module Dodge.Item.Weapon.UseEffect
     where
 import Dodge.Data
-import Dodge.Base
 import Dodge.Zone
 import Dodge.Picture.Layer
---import Dodge.Item.Weapon.Decoration
---import Dodge.Item.Weapon.TriggerType
---import Dodge.WorldEvent.Flash
---import Dodge.WorldEvent.ThingsHit
 import Picture
-import ShapePicture
 import Geometry
 
 import Data.Maybe
@@ -105,84 +99,4 @@ mvRadar x p w pt =
                 | otherwise = fromIntegral x / 10
     --colHelper y = color (withAlpha (y * globalAlpha) red)
 
-aTractorBeam :: Item -> Creature -> World -> World
-aTractorBeam _ cr w = over props (IM.insert i (tractorBeamAt i spos outpos dir)) w
-  where 
-    i = newProjectileKey w
-    cpos = _crPos cr
-    spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
-    xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
-    dir = _crDir cr
-    outpos = collidePointWalls cpos xpos
-        $ wallsAlongLine cpos xpos w
-
-tractorBeamAt :: Int -> Point2 -> Point2 -> Float -> Prop
-tractorBeamAt i pos outpos dir = ProjectileTimed
-    { _pjPos = pos
-    , _pjStartPos = outpos
-    , _pjVel = d
-    , _prDraw = tractorSPic
-    , _pjID = i
-    , _pjUpdate = updateTractor
-    , _pjTime = 10
-    }
-  where 
-    d  = unitVectorAtAngle dir
-
-{- |
-The interaction of this with objects, walls etc needs more thought.  -}
-updateTractor :: Prop -> World -> World
-updateTractor pj w
-    | _pjTime pj <= 0 = w & props %~ IM.delete i
-    | otherwise = w
-        & props . ix i . pjTime -~ 1
-        & creatures     %~ IM.map (tractCr   pullVel pos outpos)
-        & floorItems    %~ IM.map (tractFlIt pullVel pos outpos)
-  where 
-    i = _pjID pj
-    pullVel = _pjVel pj
-    pos = _pjPos pj
-    outpos = _pjStartPos pj
-
-tractFlIt :: Point2 -> Point2 -> Point2 -> FloorItem -> FloorItem
-tractFlIt q p1 outpos it 
-    | circOnSeg p1 outpos (_flItPos it) 10 = it & flItPos %~ tractorPullPos q p1
-    | otherwise = it
-
-tractCr :: Point2 -> Point2 -> Point2 -> Creature -> Creature
-tractCr q p1 outpos cr
-    | circOnSeg p1 outpos (_crPos cr) 10 = cr & crPos %~ tractorPullPos q p1
-    | otherwise = cr
-
-tractorPullPos :: Point2 -> Point2 -> Point2 -> Point2
-tractorPullPos q p1 p = p -.- m *.* (0.3/ x' *.* q +.+ g y *.* p4)
-  where
-    x' = abs y + 1
-    y = errorClosestPointOnLineParam 1 p1 p3 p
-    m | dist p p1 < 350 = 1
-      | otherwise        = (400 - dist p p1) / 50
-    g x | x > 5 = (10 - x) / 250
-        | x > 1 = 0.02
-        | x > -1 = x * 0.02
-        | x > -5 = -0.02
-        | otherwise = (x - 10) / 250
-    --p4 = vNormal p5
-    p4 = vNormal $ safeNormalizeV q
-    p3 = p1 +.+ p4
-
-tractorSPic :: Prop -> SPic
-tractorSPic pj = (,) mempty $ setLayer 1 $ setDepth 20 $ color (withAlpha 0.5 col) $ polygon 
-    [ spos  -- not sure if this is anticlockwise...
-    , spos +.+ size *.* (d +.+ n)
-    , xpos +.+ size *.* n
-    , xpos -.- size *.* n
-    , spos +.+ size *.* (d -.- n)
-    ]
-  where
-    size = fromIntegral (_pjTime pj)
-    spos = _pjPos pj
-    xpos = _pjStartPos pj
-    d = safeNormalizeV $ spos -.- xpos
-    n = vNormal d
-    col = mixColors 0.5 0.5 white blue
     

src/Dodge/Layout/Generate.hs

@@ -21,5 +21,3 @@ randomTreeStructure = undefined
 treeMaxDepthFromTrunk :: Int -> Int -> State g (Tree ())
 treeMaxDepthFromTrunk = do
     undefined
-
-

src/Dodge/Layout/Tree/GenerateStructure.hs

@@ -44,4 +44,3 @@ aTreeStrut = do
     bs  <- replicateM nbs smallBranch
     let trunk = treePath d
     return $ foldr (uncurry addBranchAt) trunk $ zip bds bs
-

src/Dodge/Layout/Tree/Polymorphic.hs

@@ -8,6 +8,13 @@ For example, in the tree
 the nodes in the trunk are [a,b] (note that d is not the first child of b).
  -}
 module Dodge.Layout.Tree.Polymorphic
+    ( applyToRoot
+    , treeFromPost
+    , treeFromTrunk
+    , splitTrunk
+    , applyToRandomNode
+    , addToTrunk
+    )
     where
 import Dodge.RandomHelp
 
@@ -40,9 +47,10 @@ Applies a function to the root of a tree.
 applyToRoot :: (a -> a) -> Tree a -> Tree a
 applyToRoot f (Node t ts) = Node (f t) ts
 
--- | Consider defining this using generalised recursion patterns
+-- find use for?
-treeSize :: Tree a -> Int
+---- | Consider defining this using generalised recursion patterns
-treeSize = length . flatten
+--treeSize :: Tree a -> Int
+--treeSize = length . flatten
 
 {- |
 Applies a function to a specific node determined by a list of indices.
@@ -54,17 +62,19 @@ applyToNode (i:is) f (Node x xs) = Node x (ys ++ [applyToNode is f z] ++ zs)
   where
     (ys, z:zs) = splitAt i xs
 
-{- |
+-- do not delete: find use for
-Applies a function to the first node along a trunk that satisfies a given property.
+--{- |
--}
+--Applies a function to the first node along a trunk that satisfies a given property.
-applyToSubTrunkBy :: (a -> Bool) -> (Tree a -> Tree a) -> Tree a -> Tree a
+---}
-applyToSubTrunkBy cond f (Node x (t:ts))
+--applyToSubTrunkBy :: (a -> Bool) -> (Tree a -> Tree a) -> Tree a -> Tree a
-    | cond x    = f (Node x (t:ts))
+--applyToSubTrunkBy cond f (Node x (t:ts))
-    | otherwise = Node x (applyToSubTrunkBy cond f t : ts)
+--    | cond x    = f (Node x (t:ts))
-applyToSubTrunkBy _ _ t = t
+--    | otherwise = Node x (applyToSubTrunkBy cond f t : ts)
+--applyToSubTrunkBy _ _ t = t
 
-zipTree :: Tree a -> Tree b -> Tree (a,b)
+-- find use for?
-zipTree (Node x xs) (Node y ys) = Node (x,y) $ zipWith zipTree xs ys
+--zipTree :: Tree a -> Tree b -> Tree (a,b)
+--zipTree (Node x xs) (Node y ys) = Node (x,y) $ zipWith zipTree xs ys
 
 {- |
 Makes each node into its child number, i.e. the index it has 

src/Dodge/Layout/Tree/Shift.hs

@@ -11,7 +11,6 @@ import Dodge.Room.Data
 import Dodge.Room.Link
 import Dodge.Layout.Tree.Polymorphic
 import Geometry.ConvexPoly
---import Geometry.Data
 
 import Data.Tree
 import Data.Sequence hiding (zipWith)

src/Dodge/LevelGen.hs

@@ -10,7 +10,6 @@ module Dodge.LevelGen
     ) where
 import Dodge.Data
 import Dodge.LevelGen.Block
-import Dodge.LevelGen.LineBlock
 import Dodge.LevelGen.Pathing
 import Dodge.LevelGen.StaticWalls
 import Dodge.LevelGen.AutoDoor

src/Dodge/LevelGen/Block.hs

@@ -1,6 +1,7 @@
 {- | Creation, update and destruction of destructible walls.  -}
 module Dodge.LevelGen.Block 
     ( putBlock
+    , putLineBlock
     )
     where
 import Dodge.Data
@@ -60,3 +61,49 @@ putBlock (p:ps) i c b is w = (0, foldr (uncurry removePathsCrossing) wWithBlock
     pairs = zip (p:ps) (ps ++ [p])
     wWithBlock = addBlock (p:ps) i c b is w
 putBlock _ _ _ _ _ _ = error "Trying to put a block with incomplete polygon"
+
+{- | Splits a line into many four cornered blocks. -}
+putLineBlock 
+    :: Wall     -- ^ Base pane
+    -> Float    -- ^ Block width
+    -> Float    -- ^ Block depth
+    -> Point2   -- ^ Start point (symmetric)
+    -> Point2   -- ^ End point (symmetric)
+    -> World 
+    -> (Int, World)
+putLineBlock basePane blockWidth depth a b w = (,) 0 
+    $ removePathsCrossing a b $ foldr insertWall (insertBlocks w) listWalls
+  where 
+    d = dist a b
+    rot = argV (b -.- a)
+    psOnLine = divideLineOddNumPoints blockWidth a b
+    halfBlockWidth = d / fromIntegral (length psOnLine - 1)
+    blockCenPs = snd $ evenOddSplit psOnLine
+    numBlocks = length blockCenPs
+    is = [0.. numBlocks - 1]
+    cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block
+    cornersAt p = fmap ( (p +.+) . rotateV rot) cornerPoints
+    linesAt p = makeLoopPairs $ cornersAt p
+    k = IM.newKey $ _walls w
+    blid = IM.newKey $ _blocks w
+    insertBlock i = over blocks $ IM.insert (i+blid) Block 
+        {_blID = i + blid, _blWallIDs = ksAtI i, _blHPs = [5,5], _blShadows = shadowsAt i}
+    insertBlocks = flip (foldr insertBlock) is
+    ksAtI i = map ( + (k + i*4) ) [0,1,2,3]
+    visibilityAt i 
+        | i == 0             = [ True,True,False,True]
+        | i == numBlocks - 1 = [False,True, True,True]
+        | otherwise          = [False,True,False,True]
+    shadowsAt i
+        | i == 0             = ksAtI 1
+        | i == numBlocks - 1 = ksAtI $ numBlocks - 2
+        | otherwise          = ksAtI (i-1) ++ ksAtI (i+1)
+    makeWallAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
+    makePane i visStatus k' ps = basePane
+        {_wlID = k'
+        ,_wlBlockID = Just' $ i + blid
+        ,_wlLine = ps
+        ,_wlDraw = visStatus
+        }
+    listWalls = concat $ zipWith makeWallAt blockCenPs is
+    insertWall wl = over walls $ IM.insert (_wlID wl) wl

src/Dodge/LevelGen/DoorPane.hs

@@ -1,12 +1,9 @@
 module Dodge.LevelGen.DoorPane
     ( rectanglePairs
     ) where
---import Dodge.Data
 import Geometry.Vector
 import Geometry.Data
 
-
-
 rectanglePairs :: Float -> Point2 -> Point2 -> [(Point2,Point2)]
 rectanglePairs wdth a b =
     [ (aup, ad)

src/Dodge/LevelGen/InnerWalls.hs

@@ -1,44 +0,0 @@
-module Dodge.LevelGen.InnerWalls
-  where
---import Dodge.Data
---import Dodge.Base
---import Geometry
-
---import Control.Lens
---import qualified Data.IntMap.Strict as IM
-------------------------------------------------------------------------------------
--- idea: create inner walls to draw and to cast shadows
---createInnerWalls :: IM.IntMap Wall -> IM.IntMap Wall
---createInnerWalls wls = IM.map (createInnerWall wls) wls
---
---createInnerWall :: IM.IntMap Wall -> Wall -> Wall
---createInnerWall walls wl = wl & wlLine %~ \l -> l ++ [wlL,wlR]
---  where wl0 = _wlLine wl !! 0
---        wl1 = _wlLine wl !! 1
---        wlLeft = findWallLeft wl walls
---        wlRight = findWallRight wl walls
---        wlN = normalizeV $ vNormal $ wl1 -.- wl0
---        rN = normalizeV $ vNormal $ (_wlLine wlRight !! 1) -.- (_wlLine wlRight !! 0)
---        lN = normalizeV $ vNormal $ (_wlLine wlLeft  !! 1) -.- (_wlLine wlLeft  !! 0)
---        wlR = wl0 +.+ 20 *.* normalizeV (wlN +.+ rN)
---        wlL = wl1 +.+ 20 *.* normalizeV (wlN +.+ lN)
---
---findWallLeft :: Wall -> IM.IntMap Wall -> Wall
---findWallLeft wl wls = case filter (\w -> _wlID w /= _wlID wl) $ IM.elems $ findWallsLeft (_wlLine wl !! 1) wls of
---    [w] -> w
---    wls   -> error $ "findWallLeft: " ++ show (map _wlID wls)
---                                                                 ++ " wlLines: "++ show (map _wlLine wls)
---
---findWallRight :: Wall -> IM.IntMap Wall -> Wall
---findWallRight wl wls = case filter (\w -> _wlID w /= _wlID wl) $ IM.elems $ findWallsRight (_wlLine wl !! 0) wls of
---    [w] -> w
---    wls   -> error $ "findWallRight: wall with ID " ++ show (_wlID wl) ++ " and points " ++
---                    show (_wlLine wl) ++ "\nhas a right corner with and only with the walls "
---                    ++ show (map _wlID wls) ++ "\nwlLines "++ show (map _wlLine wls)
---                    ++ "\nUnless a wall has a corner with exactly one other wall, there is a problem"
---
---findWallsLeft :: Point2 -> IM.IntMap Wall -> IM.IntMap Wall
---findWallsLeft x wls = IM.filter (\wl -> dist x (_wlLine wl !! 0) < 1) wls
---
---findWallsRight :: Point2 -> IM.IntMap Wall -> IM.IntMap Wall
---findWallsRight x wls = IM.filter (\wl -> dist x (_wlLine wl !! 1) < 1) wls

src/Dodge/LevelGen/LineBlock.hs

@@ -1,56 +0,0 @@
-{- | Splits a line into many four cornered blocks. -}
-module Dodge.LevelGen.LineBlock
-    ( putLineBlock
-    ) where
-import Dodge.Data
-import Dodge.Base
-import Dodge.LevelGen.Pathing
-import Geometry
-import qualified IntMapHelp as IM
-
-import Control.Lens
-
-putLineBlock 
-    :: Wall     -- ^ Base pane
-    -> Float    -- ^ Block width
-    -> Float    -- ^ Block depth
-    -> Point2   -- ^ Start point (symmetric)
-    -> Point2   -- ^ End point (symmetric)
-    -> World 
-    -> (Int, World)
-putLineBlock basePane blockWidth depth a b w = (,) 0 
-    $ removePathsCrossing a b $ foldr insertWall (insertBlocks w) listWalls
-  where 
-    d = dist a b
-    rot = argV (b -.- a)
-    psOnLine = divideLineOddNumPoints blockWidth a b
-    halfBlockWidth = d / fromIntegral (length psOnLine - 1)
-    blockCenPs = snd $ evenOddSplit psOnLine
-    numBlocks = length blockCenPs
-    is = [0.. numBlocks - 1]
-    cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block
-    cornersAt p = fmap ( (p +.+) . rotateV rot) cornerPoints
-    linesAt p = makeLoopPairs $ cornersAt p
-    k = IM.newKey $ _walls w
-    blid = IM.newKey $ _blocks w
-    insertBlock i = over blocks $ IM.insert (i+blid) Block 
-        {_blID = i + blid, _blWallIDs = ksAtI i, _blHPs = [5,5], _blShadows = shadowsAt i}
-    insertBlocks = flip (foldr insertBlock) is
-    ksAtI i = map ( + (k + i*4) ) [0,1,2,3]
-    visibilityAt i 
-        | i == 0             = [ True,True,False,True]
-        | i == numBlocks - 1 = [False,True, True,True]
-        | otherwise          = [False,True,False,True]
-    shadowsAt i
-        | i == 0             = ksAtI 1
-        | i == numBlocks - 1 = ksAtI $ numBlocks - 2
-        | otherwise          = ksAtI (i-1) ++ ksAtI (i+1)
-    makeWallAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
-    makePane i visStatus k' ps = basePane 
-        {_wlID = k'
-        ,_wlBlockID = Just' $ i + blid
-        ,_wlLine = ps
-        ,_wlDraw = visStatus
-        }
-    listWalls = concat $ zipWith makeWallAt blockCenPs is
-    insertWall wl = over walls $ IM.insert (_wlID wl) wl

src/Dodge/LevelGen/MoveDoor.hs

@@ -11,7 +11,6 @@ import Geometry
 
 import Control.Lens
 
--- This deserves a clean up
 mvP :: Float -> Point2 -> Point2 -> Point2
 {-# INLINE mvP #-}
 mvP !speed !ep !p = mvPointTowardAtSpeed speed ep p
@@ -38,4 +37,3 @@ changeZonedWall
     -> World
     -> World
 changeZonedWall eff n (x,y) = over (wallsZone . znObjects) $ adjustIMZone eff x y n
-

src/Dodge/LevelGen/Pathing.hs

@@ -25,7 +25,7 @@ removePathsCrossing :: Point2 -> Point2 -> World -> World
 removePathsCrossing a b w = w
     & pathGraph  .~ newGraph 
     & pathGraphP .~ pg'
-    & pathPoints .~ (foldr insertPoint IM.empty (labNodes newGraph))
+    & pathPoints .~ foldr insertPoint IM.empty (labNodes newGraph)
   where 
     pg' = filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraphP w
     insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]

src/Dodge/Menu.hs

@@ -89,7 +89,7 @@ soundMenuOptions =
     dec x = max 0 (x - 0.1)
     inc x = min 1 (x + 0.1)
     --sw w = w & sideEffects %~ (setVol (_config w) : )
-    sw w = w & sideEffects %~ setVol' (_config w)
+    sw w = w & sideEffects %~ setVolThen (_config w)
     master g    = Just . (config . volume_master %~ g)
     soundEffs g = Just . (config . volume_sound %~ g)
     music g     = Just . (config . volume_music %~ g)

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -26,7 +26,7 @@ import Control.Monad.State
 bulHitCr :: Particle -> Point2 -> Creature -> World -> World
 bulHitCr bt p cr w 
     | crIsArmouredFrom p cr
-        = createSparkCol 8 colID p1 (argV (p1 -.- p) + d1) . addDamageArmoured $ w
+        = colSpark 8 colID p1 (argV (p1 -.- p)) $ addDamageArmoured w
     | otherwise = addDamage . bulletHitSound p $ w
   where
     sp = head $ _btTrail' bt
@@ -36,7 +36,6 @@ bulHitCr bt p cr w
     addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
     addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
     cid = _crID cr
-    (d1,_)  = randomR (-0.7,0.7) $ _randGen w
     colID = _btColor' bt
     p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
 
@@ -135,16 +134,14 @@ bulConCr' bt p cr w
 bulHitWall :: Particle -> Point2 -> Wall -> World -> World
 bulHitWall bt p wl w = damageBlocksBy 5 wl
     . smokeCloudAt dustcol 20 200 1 (addZ 20 pOut)
-    . createSparkCol 8 theCol pOut (reflectDir wl)
+    $ colSpark' 0.2 8 theCol pOut (reflectDir wl)
-    $ set randGen g
     w
   where 
     dustcol = _wlColor wl & _4 .~ 1
     theCol = brightX 100 1.5 white
     sp = head $ _btTrail' bt
     pOut = p +.+ safeNormalizeV (sp -.- p)
-    (a, g) = randomR (-0.2,0.2) $ _randGen w
+    reflectDir wall = argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
-    reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
 {- | Bounce off walls, do damage to blocks.  -}
 bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World
 bulBounceWall' bt p wl w = damageBlocksBy 5 wl $ over worldEvents addBouncer w
@@ -201,6 +198,5 @@ hvBulHitWall bt p x w =  damageBlocksBy 5 x $ set randGen g $ foldr ($) w (spark
     sv = unitVectorAtAngle $ reflectDir x
     cs'      = take 10 $ randomRs (0,11) $ _randGen w
     cs      = map (brightX 100 1.5 . numColor) cs'
-    ds      = randomRs (-0.7,0.7) $ _randGen w
     ts      = randomRs (4,8) $ _randGen w
-    sparks pos vel = zipWith3 (\t c d -> createSparkCol t c pos (argV vel + d)) ts cs ds
+    sparks pos vel = zipWith (\t c -> colSpark t c pos (argV vel)) ts cs

src/Dodge/Room.hs

@@ -6,8 +6,7 @@ module Dodge.Room
     , module Dodge.Room.Corridor
     ) where
 import Dodge.Default.Room
-import Dodge.Item.Weapon
+import Dodge.Item.Weapon.BulletGuns
-import Dodge.Item.Weapon.AutoGun
 import Dodge.Item.Weapon.Launcher
 import Dodge.Creature
 import Dodge.Room.Foreground

src/Dodge/Update/Camera.hs

@@ -60,10 +60,10 @@ updateScopeZoom w
       = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
                           . itAttachment . scopeZoomChange of
         Just x 
-           | x > 9     -> zoomInLongGun $ zoomInLongGun $   w
+           | x > 9     -> zoomInLongGun $ zoomInLongGun w
-           | x > 0     -> zoomInLongGun $                   w
+           | x > 0     -> zoomInLongGun w
-           | x < -9    -> zoomOutLongGun $ zoomOutLongGun $ w
+           | x < -9    -> zoomOutLongGun $ zoomOutLongGun w
-           | x < 0     -> zoomOutLongGun $                  w
+           | x < 0     -> zoomOutLongGun w
            | otherwise -> w
         _                  -> w
     | otherwise = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -2,11 +2,12 @@
 Creation of particles in the world.
  -}
 module Dodge.WorldEvent.SpawnParticle
-    ( createSparkCol
+    ( makeGasCloud
-    , makeGasCloud
     , aFlameParticle
     , makeFlameletTimed
     , makeTeslaArcAt
+    , colSpark
+    , colSpark'
     ) where
 import Dodge.Data
 import Dodge.Data.DamageType
@@ -260,15 +261,12 @@ makeTeslaArcAt col pos dir = LinearParticle
     , _ptColor = brightX 100 1.5 col
     }
 drawTeslaArc :: Particle -> Picture
-drawTeslaArc pt = pic
+drawTeslaArc pt = setLayer 1 $ pictures 
+    [ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ lineOfThickness  3 ps
+    , setDepth 20   $ color (V4 0 0 0 0.5)              $ lineOfThickness 10 ps
+    ]
   where
-    ps' = _ptPoints pt
+    ps = _ptPoints pt
-    pic = setLayer 1 $ pictures 
-             [ setDepth 20.5 $ color (brightX 2 2 $ _ptColor pt) $ lineOfThickness 3 ps'
---             , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps'
---             , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps'
---             , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps'
-             ]
 -- todo: fix electrical damage location
 moveTeslaArc 
     :: Point2   -- ^ Emmission position
@@ -279,7 +277,7 @@ moveTeslaArc
 moveTeslaArc p d w pt
     | t == 2 = 
         (foldr damCrs w hitCrs & randGen .~ g
-            & createSparkCol 8 nc q2 (argV sv + d1)
+            & colSpark 8 nc q2 (argV sv)
         , Just $ pt 
             & ptTimer -~ 1
             & ptPoints .~ ps'
@@ -305,39 +303,28 @@ moveTeslaArc p d w pt
     q1 = last $ init ps'
     q2 = last ps'
     hitWall = reflectPointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
-    (d1,_)  = randomR (-0.7,0.7) $ _randGen w
     sv = maybe (q2 -.- q1) snd hitWall
-
+{- Finds a point somewhere roughly inbetween two points.  -}
-{-
-Finds a point somewhere roughly inbetween two points.
- -}
 lightningMid :: Float -> Point2 -> Point2 -> Point2
 lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3
     where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2
-
+{- Finds extra middle points between successive points in a list of points.  -}
-{-
-Finds extra middle points between successive points in a list of points.
--}
 lightningMids :: Float -> [Point2] -> [Point2] -> [Point2]
 lightningMids d1 (p:pers) (p1:p3:ps)
     = let p2 = p +.+ lightningMid d1 p1 p3
           d2 = argV $ p3 -.- p2
       in  p1 : p2 : lightningMids d2 pers (p3:ps)
 lightningMids _ _ ps = ps
-
+{- Finds a list of hit things from a given point.
-{-
+'E3x1' objects are creatures, 'E3x2' objects are points on walls, 'E3x3' objects are points in space.  -}
-Finds a list of hit things from a given point.
-'E3x1' objects are creatures, 'E3x2' objects are points on walls, 'E3x3' objects are points in space.
- -}
 crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2]
-crsLightChain p d wlAttract w
+crsLightChain p d wlAttract w = case crOrWallSensitive p d wlAttract w of
-    = case crOrWallSensitive p d wlAttract w of
+    E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p)) 
-        E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p)) 
+                                       (min 1 (wlAttract + 0.3)) w
-                                           (min 1 (wlAttract + 0.3)) w
+    E3x2 p1 -> [E3x2 p1]
-        E3x2 p1 -> [E3x2 p1]
+    E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w)
-        E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w)
+  where 
-    -- where (dChange, g) = (0, _randGen w)
+    (dChange, g) = randomR (-0.5,0.5) $ _randGen w
-    where (dChange, g) = randomR (-0.5,0.5) $ _randGen w
 {-
 Finds whether a creature or wall is in front of a given point and direction.
 Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'.
@@ -349,8 +336,7 @@ crOrWallSensitive
     -> Float    -- ^ Wall attraction parameter
     -> World 
     -> Either3 Creature Point2 Point2
-crOrWallSensitive p dir wlAttract w = 
+crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0))
-    fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0))
     . listToMaybe 
     . sortBy (compare `on` g)
     $ catMaybes [cr,wlp]
@@ -374,12 +360,16 @@ crOrWallSensitive p dir wlAttract w =
     g _ = 0
     (arcLen,_) = randomR (25,50) $ _randGen w
 -- BUG: can hit crs through walls
--- | Create a spark. 
+
--- If the spark is created by another Particle, it cannot be directly added to
+colSpark :: Int -> Color -> Point2 -> Float -> World -> World
--- the list, hence the redirect through worldEvents.
+colSpark = colSpark' 0.7
-createSparkCol :: Int -> Color -> Point2 -> Float -> World -> World
+colSpark' :: Float -> Int -> Color -> Point2 -> Float -> World -> World
-createSparkCol time col pos dir = worldEvents %~ ( over particles (spark :) . )
+colSpark' randDir time col pos baseDir w = w 
+    & worldEvents %~ ( over particles (spark :) . )
+    & randGen .~ g
   where 
+    (a,g)  = randomR (-randDir,randDir) $ _randGen w
+    dir = a + baseDir
     spark = BulletPt
         { _ptDraw = drawBul
         , _ptUpdate = mvGenBullet
@@ -391,8 +381,7 @@ createSparkCol time col pos dir = worldEvents %~ ( over particles (spark :) . )
         , _btTimer' = time
         , _btHitEffect' = destroyOnImpact sparkEff noEff
         }
-    sparkEff bt p cr
+    sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
-        = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
       where 
         sp = head (_btTrail' bt)
         ep = sp +.+ _btVel' bt