Start work on lasguns

src/Dodge/Beam.hs

@@ -65,8 +65,8 @@ mvLaser :: Float    -- ^ Phase velocity, controls deflection through windows
     -> World 
     -> Particle 
     -> (World, Maybe Particle)
-mvLaser phasev sp dir w pt
+mvLaser phasev sp dir w pt =
-    = ( damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w
+    ( damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w
     , Just pt {_ptPoints = sp:ps ,_ptUpdate = ptSimpleTime 0 }
     )
   where
@@ -76,9 +76,12 @@ mvLaser phasev sp dir w pt
     (thHit, ps) = reflectLaserAlong phasev sp xp w
 
 drawLaser :: Particle -> Picture
-drawLaser pt = setLayer BloomNoZWrite $ pictures
+--drawLaser pt = setLayer BloomNoZWrite $ pictures
-    [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 20 ps
+    --[ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 20 ps
-    , setDepth 19.5 . color (brightX 10 1 col)  $ thickLine 3  ps
+drawLaser pt =
+    setLayer BloomNoZWrite $ pictures
+--    [ setDepth 19   . color (brightX 1 0.5 col) $ thickLine 20 ps
+    [ setDepth 19.5 . color (brightX 10 1 col)  $ thickLine 3  ps
     ]
   where
     col = _ptColor pt

src/Dodge/Combine/Combinations.hs

@@ -65,7 +65,7 @@ itemCombinations =
 --    , p [o LASGUN,o PIPE] lasGunPulse
     , p [o LASGUN,p 2 $ cr PIPE] lasDual
     , p [o LASGUN,o $ cr PIPE, o $ cr PRISM] lasWidePulse
-    , p [o LASGUN,o $ cr TRANSFORMER,o $ cr PRISM] (lasWide 2)
+    , p [o LASGUN,o $ cr TRANSFORMER] (lasGunWide 2)
 
     , p [o $ cr TRANSFORMER,p 2 $ cr CAN] sparkGun
     , p [o SPARKGUN,p 2 $ cr PIPE] teslaGun
@@ -83,7 +83,7 @@ itemCombinations =
 
     , p [p 2 $ cr PLATE] flatShield
     ] 
-    ++ map (\i -> po [LASGUNWIDE i,cr TRANSFORMER,cr PRISM] $ lasWide (i+1)) [2..9]
+    ++ map (\i -> po [LASGUNWIDE i,cr TRANSFORMER] $ lasGunWide (i+1)) [2..9]
 --    ++ map (\i -> po [LASGUNWIDE i,cr HARDWARE] $ lasFocus i) [2..10]
     ++ map (\i -> po [cr PIPE,BANGSTICK i] $ bangStick (i+1)) [1..8]
     ++ map (\i -> po [REVOLVERX i,cr CAN]  $ revolverX (i+1)) [1..5]
@@ -182,7 +182,7 @@ batteryGuns =
     , lasSway
     , lasSwing
     ] ++ 
-    [ lasWide i | i <- [1..10]
+    [ lasGunWide i | i <- [2..10]
     ] 
 --    ++
 --    [ lasFocus i | i <- [1..10]]

src/Dodge/Creature.hs

@@ -228,18 +228,7 @@ inventoryX c = case c of
            , makeTypeCraftNum 2 MICROCHIP 
            ]
     'J' -> [ lasGun
-            , lasSwing
+            , makeTypeCraftNum 10 TRANSFORMER
-            , lasDual
-            , lasWide 1
-            , lasWide 2
-            , lasWide 3
-            , lasWide 4
-            , lasWide 5
-            , lasWidePulse
-            , lasFocus 1
-            , lasFocus 2
-            , lasFocus 3
-            , lasFocus 6
             ]
     _ -> []
 

src/Dodge/Item.hs

@@ -64,7 +64,7 @@ itemFromBase ibt = case ibt of
     LASGUNSWING     -> lasSwing
     LASGUNSWAY  -> lasSway
     LASGUNWIDEPULSE     -> lasWidePulse
-    LASGUNWIDE i  -> lasWide i
+    LASGUNWIDE i  -> lasGunWide i
     LASGUNFOCUS i     -> lasFocus i
     SONICGUN    -> sonicGun
     TRACTORGUN  -> tractorGun

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -1,7 +1,7 @@
 module Dodge.Item.Weapon.BatteryGuns
     ( lasGun
     , lasDual
-    , lasWide
+    , lasGunWide
     , lasWidePulse
     , lasSway
     , lasSwing
@@ -122,8 +122,8 @@ lasPulse = lasGun
     frac it = 0.5 * (1 + sin (pi * fromIntegral (_lasCycle $ _itParams it) * 0.1))
     
 
-lasWide :: Int -> Item
+lasGunWide :: Int -> Item
-lasWide n = lasGun
+lasGunWide n = lasGun
     & itType . iyBase .~ LASGUNWIDE n
     & itParams . lasColor .~ orange
     & itParams . lasDamage .~ 2
@@ -141,7 +141,7 @@ lasWide n = lasGun
         )
   where
     n' = 9 * n
-    xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2)  | x <- [0..n'-1] ]
+    xs = [ 0.5 * (fromIntegral x - fromIntegral (n'-1) /2)  | x <- [0..n'-1] ]
 lasWidePulse :: Item
 lasWidePulse = lasGun
     & itType . iyBase .~ LASGUNWIDEPULSE
@@ -192,7 +192,7 @@ lasSway = lasGun
       where
         x' = _lasCycle $ _itParams it
 lasFocus :: Int -> Item
-lasFocus n = lasWide n
+lasFocus n = lasGunWide n
     & itType . iyBase .~ LASGUNFOCUS n
     & itParams . lasColor .~ red
     & itUse . useMods .~

src/Dodge/Item/Weapon/LaserPath.hs

@@ -14,19 +14,17 @@ import Data.Tuple
 --import Streaming
 --import qualified Streaming.Prelude as S
 
--- not sure why we need to keep a list of seen walls, but seems to loop
--- infinitely when removed
 -- this needs to be tested with both reflections and refractions
--- the distance of the laser should be limited
 reflectLaserAlong :: Float -> Point2 -> Point2 -> World 
     -> (Maybe (Point2,Either Creature Wall),[Point2])
-reflectLaserAlong phasev sp ep w = case thingHit sp ep w of
+{-# INLINE reflectLaserAlong #-}
+reflectLaserAlong phasev sp ep w = case thingHitFilt (const True) _wlDraw sp ep w of
     Just (p,Right wl) 
         | _wlReflect wl -> second (p:) $ reflectLaserAlong phasev 
             (p +.+ unitVectorAtAngle (reflDirWall sp p wl))
             (p +.+ (dist p ep) *.* unitVectorAtAngle (reflDirWall sp p wl)) 
             w
-        | wlIsSeeThrough wl && _wlSeen wl -> second (p:) $ reflectLaserAlong phasev 
+        | wlIsSeeThrough wl -> second (p:) $ reflectLaserAlong phasev 
             (p +.+ normalizeV (refract sp ep wl p))
             (refract sp ep wl p) 
             w

src/Dodge/Item/Weapon/TriggerType.hs

@@ -595,4 +595,4 @@ duplicateOffsets xs eff item cr w = foldr f w poss
   where
     poss :: [V2 Float]
     poss = map (rotateV (_crDir cr) . V2 0 ) xs
-    f pos = eff item (cr & crPos %~ (+.+ pos))
+    f pos = eff item (cr & crPos +.+.~ pos)

src/Dodge/WorldEvent/ThingsHit.hs

@@ -5,6 +5,7 @@ Find which objects lie upon a line.
 module Dodge.WorldEvent.ThingsHit
     ( thingsHit
     , thingHit
+    , thingHitFilt
     , thingsHitExceptCr
     )
     where
@@ -35,6 +36,13 @@ crsHit sp ep
         . overlap1SegCrs sp ep
         . crsNearSeg sp ep
 
+thingHitFilt :: (Creature -> Bool) -> (Wall -> Bool) 
+    -> Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
+thingHitFilt fcr fwl sp ep = runIdentity . S.head_ . S.filter (f . snd) . thingsHit sp ep
+  where
+    f (Left cr) = fcr cr
+    f (Right wl) = fwl wl
+
 thingHit :: Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
 thingHit sp ep = runIdentity . S.head_ . thingsHit sp ep
 

src/LensHelp.hs

@@ -5,6 +5,7 @@ module LensHelp
     , (++.~)
     , (.*.*~)
     , (.+.+~)
+    , (+.+.~)
     ) where
 import Geometry
 import Control.Lens
@@ -23,6 +24,11 @@ infixr 4 .+.+~
 {-# INLINABLE (.+.+~) #-}
 (.+.+~) m x = m %~ (x +.+)
 
+infixr 4 +.+.~
+(+.+.~) :: ASetter s t Point2 Point2 -> Point2 -> s -> t
+{-# INLINABLE (+.+.~) #-}
+(+.+.~) m x = m %~ (+.+ x)
+
 infixr 4 .++~
 (.++~) :: ASetter s t [a] [a] -> [a] -> s -> t
 (.++~) m x = m %~ (x ++)